]> git.proxmox.com Git - pve-http-server.git/blobdiff - src/PVE/APIServer/AnyEvent.pm
multipart upload: ignore trailing-newline requirement from spec
[pve-http-server.git] / src / PVE / APIServer / AnyEvent.pm
index f6edecebb9233baa4b12bb6621479cd9b8fc7dbc..3cd77fae4115dd63f31034af67ca8ecdddec00b9 100644 (file)
@@ -46,7 +46,7 @@ use URI;
 
 use PVE::INotify;
 use PVE::SafeSyslog;
-use PVE::Tools;
+use PVE::Tools qw(trim);
 
 use PVE::APIServer::Formatter;
 use PVE::APIServer::Utils;
@@ -293,11 +293,18 @@ sub response {
 
     my $code = $resp->code;
     my $msg = $resp->message || HTTP::Status::status_message($code);
-    ($msg) = $msg =~m/^(.*)$/m;
     my $content = $resp->content;
 
+    # multiline mode only checks \n for $, so explicitly check for any \n or \r afterwards
+    ($msg) = $msg =~ m/^(.*)$/m;
+    if ($msg =~ /[\r\n]/) {
+       $code = 400; # bad request from user
+       $msg = HTTP::Status::status_message($code);
+       $content = '';
+    }
+
     if ($code =~ /^(1\d\d|[23]04)$/) {
-       # make sure content we have no content
+       # make sure informational, no content and not modified response send no content
        $content = "";
     }
 
@@ -419,6 +426,7 @@ sub send_file_start {
            if (ref($download) eq 'HASH') {
                $mime = $download->{'content-type'};
                my $encoding = $download->{'content-encoding'};
+               my $disposition = $download->{'content-disposition'};
 
                if ($download->{path} && $download->{stream} &&
                    $reqstate->{request}->header('PVEDisableProxy'))
@@ -431,6 +439,7 @@ sub send_file_start {
                        Content_Type => $mime,
                    );
                    $header->header('Content-Encoding' => $encoding) if defined($encoding);
+                   $header->header('Content-Disposition' => $disposition) if defined($disposition);
                    # we need some data so Content-Length gets set correctly and
                    # the proxy doesn't wait for more data - place a canary
                    my $resp = HTTP::Response->new(200, "OK", $header, "error canary");
@@ -449,6 +458,7 @@ sub send_file_start {
                if ($download->{stream}) {
                    my $header = HTTP::Headers->new(Content_Type => $mime);
                    $header->header('Content-Encoding' => $encoding) if defined($encoding);
+                   $header->header('Content-Disposition' => $disposition) if defined($disposition);
                    my $resp = HTTP::Response->new(200, "OK", $header);
                    $self->response($reqstate, $resp, undef, 1, 0, $fh);
                    return;
@@ -695,10 +705,20 @@ sub proxy_request {
     eval {
        my $target;
        my $keep_alive = 1;
+
+       # stringify URI object and verify it starts with a slash
+       $uri = "$uri";
+       if ($uri !~ m@^/@) {
+           $self->error($reqstate, 400, "invalid proxy uri");
+           return;
+       }
+
+       my $may_stream_file;
        if ($host eq 'localhost') {
            $target = "http://$host:85$uri";
            # keep alive for localhost is not worth (connection setup is about 0.2ms)
            $keep_alive = 0;
+           $may_stream_file = 1;
        } elsif (Net::IP::ip_is_ipv6($host)) {
            $target = "https://[$host]:8006$uri";
        } else {
@@ -784,6 +804,10 @@ sub proxy_request {
                        $header->header(Location => $location);
                    }
                    if ($stream) {
+                       if (!$may_stream_file) {
+                           $self->error($reqstate, 403, 'streaming denied');
+                           return;
+                       }
                        sysopen(my $fh, "$stream", O_NONBLOCK | O_RDONLY)
                            or die "open stream path '$stream' for forwarding failed: $!\n";
                        my $resp = HTTP::Response->new($code, $msg, $header, undef);
@@ -1155,112 +1179,93 @@ sub handle_request {
     }
 }
 
+my sub assert_form_disposition {
+    die "wrong Content-Disposition '$_[0]' in multipart, expected 'form-data'\n" if $_[0] ne 'form-data';
+}
+
 sub file_upload_multipart {
     my ($self, $reqstate, $auth, $method, $path, $rstate) = @_;
 
     eval {
        my $boundary = $rstate->{boundary};
        my $hdl = $reqstate->{hdl};
-
        my $startlen = length($hdl->{rbuf});
 
-       if ($rstate->{phase} == 0) { # skip everything until start
-           if ($hdl->{rbuf} =~ s/^.*?--\Q$boundary\E  \015?\012
-                       ((?:[^\015]+\015\012)* ) \015?\012//xs) {
-               my $header = $1;
-               my ($ct, $disp, $name, $filename);
-               foreach my $line (split(/\015?\012/, $header)) {
-                   # assume we have single line headers
-                   if ($line =~ m/^Content-Type\s*:\s*(.*)/i) {
-                       $ct = parse_content_type($1);
-                   } elsif ($line =~ m/^Content-Disposition\s*:\s*(.*)/i) {
-                       ($disp, $name, $filename) = parse_content_disposition($1);
-                   }
-               }
+       my $newline_re = qr/\015?\012/;
+       my $delim_re = qr/--\Q$boundary\E${newline_re}/;
+       my $close_delim_re = qr/--\Q$boundary\E--/;
 
-               if (!($disp && $disp eq 'form-data' && $name)) {
-                   syslog('err', "wrong content disposition in multipart - abort upload");
-                   $rstate->{phase} = -1;
-               } else {
+       # Phase 0 - preserve boundary, but remove everything before
+       if ($rstate->{phase} == 0 && $hdl->{rbuf} =~ s/^.*?($delim_re)/$1/s) {
+           $rstate->{read} += $startlen - length($hdl->{rbuf});
+           $rstate->{phase} = 1;
+       }
 
-                   $rstate->{fieldname} = $name;
+       my $remove_until_data = sub {
+           my ($hdl) = @_;
+           # remove any remaining multipart "headers" like Content-Type
+           $hdl->{rbuf} =~ s/^.*?${newline_re}{2}//s;
+       };
 
-                   if ($filename) {
-                       if ($name eq 'filename') {
-                           # found file upload data
-                           $rstate->{phase} = 1;
-                           $rstate->{filename} = $filename;
-                       } else {
-                           syslog('err', "wrong field name for file upload - abort upload");
-                           $rstate->{phase} = -1;
-                       }
-                   } else {
-                       # found form data for field $name
-                       $rstate->{phase} = 2;
-                   }
-               }
-           } else {
-               my $len = length($hdl->{rbuf});
-               substr($hdl->{rbuf}, 0, $len - $rstate->{maxheader}, '')
-                   if $len > $rstate->{maxheader}; # skip garbage
+       my $extract_form_disposition = sub {
+           my ($name) = @_;
+           if ($hdl->{rbuf} =~ s/^${delim_re}.*?Content-Disposition: (.*?); name="$name"(.*?${delim_re})/$2/s) {
+               assert_form_disposition($1);
+               $remove_until_data->($hdl);
+               $hdl->{rbuf} =~ s/^(.*?)(${delim_re})/$2/s;
+               $rstate->{params}->{$name} = trim($1);
+           }
+       };
+
+       if ($rstate->{phase} == 1) { # Phase 1 - parse payload without file data
+           $extract_form_disposition->('content');
+           $extract_form_disposition->('checksum-algorithm');
+           $extract_form_disposition->('checksum');
+
+           if ($hdl->{rbuf} =~
+               s/^${delim_re}
+               Content-Disposition:\ (.*?);\ name="(.*?)";\ filename="([^"]+)"${newline_re}
+               Content-Type:\ \S*${newline_re}{2}
+               //sxx
+           ) {
+               assert_form_disposition($1);
+               die "wrong field name '$2' for file upload, expected 'filename'" if $2 ne "filename";
+               $rstate->{phase} = 2;
+               $rstate->{params}->{filename} = trim($3);
            }
-       } elsif ($rstate->{phase} == 1) { # inside file - dump until end marker
-           if ($hdl->{rbuf} =~ s/^(.*?)\015?\012(--\Q$boundary\E(--)? \015?\012(.*))$/$2/xs) {
-               my ($rest, $eof) = ($1, $3);
-               my $len = length($rest);
-               die "write to temporary file failed - $!"
-                   if syswrite($rstate->{outfh}, $rest) != $len;
-               $rstate->{ctx}->add($rest);
-               $rstate->{params}->{filename} = $rstate->{filename};
-               $rstate->{md5sum} = $rstate->{ctx}->hexdigest;
-               $rstate->{bytes} += $len;
-               $rstate->{phase} =  $eof ? 100 : 0;
+       }
+
+       if ($rstate->{phase} == 2) { # Phase 2 - dump content into file
+           my ($data, $write_length);
+           if ($hdl->{rbuf} =~ s/^(.*?)${newline_re}?+${close_delim_re}.*$//s) {
+               $data = $1;
+               $write_length = length($data);
+               $rstate->{phase} =  100;
            } else {
-               my $len = length($hdl->{rbuf});
-               my $wlen = $len - $rstate->{boundlen};
-               if ($wlen > 0) {
-                   my $data = substr($hdl->{rbuf}, 0, $wlen, '');
-                   die "write to temporary file failed - $!"
-                       if syswrite($rstate->{outfh}, $data) != $wlen;
-                   $rstate->{bytes} += $wlen;
-                   $rstate->{ctx}->add($data);
-               }
+               $write_length = length($hdl->{rbuf}) - $rstate->{boundlen};
+               $data = substr($hdl->{rbuf}, 0, $write_length, '') if $write_length > 0;
            }
-       } elsif ($rstate->{phase} == 2) { # inside normal field
-
-           if ($hdl->{rbuf} =~ s/^(.*?)\015?\012(--\Q$boundary\E(--)? \015?\012(.*))$/$2/xs) {
-               my ($rest, $eof) = ($1, $3);
-               my $len = length($rest);
-               $rstate->{post_size} += $len;
-               if ($rstate->{post_size} < $limit_max_post) {
-                   $rstate->{params}->{$rstate->{fieldname}} = $rest;
-                   $rstate->{phase} = $eof ? 100 : 0;
-               } else {
-                   syslog('err', "form data to large - abort upload");
-                   $rstate->{phase} = -1; # skip
-               }
+
+           if ($write_length > 0) {
+               syswrite($rstate->{outfh}, $data) == $write_length or die "write to temporary file failed - $!\n";
+               $rstate->{bytes} += $write_length;
+               $rstate->{ctx}->add($data);
            }
-       } else { # skip
-           my $len = length($hdl->{rbuf});
-           substr($hdl->{rbuf}, 0, $len, ''); # empty rbuf
        }
 
-       $rstate->{read} += ($startlen - length($hdl->{rbuf}));
+       if ($rstate->{phase} == 100) { # Phase 100 - transfer finished
+           $rstate->{md5sum} = $rstate->{ctx}->hexdigest;
+           my $elapsed = tv_interval($rstate->{starttime});
+           syslog('info', "multipart upload complete (size: %dB time: %.3fs rate: %.2fMiB/s md5sum: %s)",
+               $rstate->{bytes}, $elapsed, $rstate->{bytes} / ($elapsed * 1024 * 1024), $rstate->{md5sum}
+           );
+           $self->handle_api2_request($reqstate, $auth, $method, $path, $rstate);
+       }
 
-       if (!$rstate->{done} && ($rstate->{read} + length($hdl->{rbuf})) >= $rstate->{size}) {
-           $rstate->{done} = 1; # make sure we dont get called twice
-           if ($rstate->{phase} < 0 || !$rstate->{md5sum}) {
-               die "upload failed\n";
-           } else {
-               my $elapsed = tv_interval($rstate->{starttime});
-
-               my $rate = int($rstate->{bytes} / ($elapsed * 1024 * 1024));
-               syslog('info',
-                   "multipart upload complete (size: %d time: %ds rate: %.2fMiB/s md5sum: %s)",
-                    $rstate->{bytes}, $elapsed, $rate, $rstate->{md5sum}
-               );
-               $self->handle_api2_request($reqstate, $auth, $method, $path, $rstate);
-           }
+       $rstate->{read} += $startlen - length($hdl->{rbuf});
+
+       if ($rstate->{read} + length($hdl->{rbuf}) >= $rstate->{size} && $rstate->{phase} != 100) {
+           die "upload failed";
        }
     };
     if (my $err = $@) {
@@ -1283,26 +1288,6 @@ sub parse_content_type {
     return  wantarray ? ($ct) : $ct;
 }
 
-sub parse_content_disposition {
-    my ($line) = @_;
-
-    my ($disp, @params) = split(/\s*[;,]\s*/o, $line);
-    my $name;
-    my $filename;
-
-    foreach my $v (@params) {
-       if ($v =~ m/^\s*name\s*=\s*(\S+?)\s*$/o) {
-           $name = $1;
-           $name =~ s/^"(.*)"$/$1/;
-       } elsif ($v =~ m/^\s*filename\s*=\s*(.+?)\s*$/o) {
-           $filename = $1;
-           $filename =~ s/^"(.*)"$/$1/;
-       }
-    }
-
-    return  wantarray ? ($disp, $name, $filename) : $disp;
-}
-
 my $tmpfile_seq_no = 0;
 
 sub get_upload_filename {
@@ -1461,8 +1446,7 @@ sub unshift_read_header {
                    }
 
                    my $ctype = $r->header('Content-Type');
-                   my ($ct, $boundary);
-                   ($ct, $boundary)= parse_content_type($ctype) if $ctype;
+                   my ($ct, $boundary) = $ctype ? parse_content_type($ctype) : ();
 
                    if ($auth->{isUpload} && !$self->{trusted_env}) {
                        die "upload 'Content-Type '$ctype' not implemented\n"
@@ -1553,6 +1537,12 @@ sub push_request_header {
                        $self->error($reqstate, 506, "http protocol version $maj.$min not supported");
                        return;
                    }
+                   if ($url =~ m|^[^/]*@|) {
+                       # if an '@' comes before the first slash proxy forwarding might consider
+                       # the frist part of the url to be part of an authority...
+                       $self->error($reqstate, 400, "invalid url");
+                       return;
+                   }
 
                    $self->{request_count}++; # only count valid request headers
                    if ($self->{request_count} >= $self->{max_requests}) {
@@ -1908,10 +1898,18 @@ sub new {
        if (delete $self->{ssl}->{honor_cipher_order}) {
            $tls_ctx_flags |= &Net::SSLeay::OP_CIPHER_SERVER_PREFERENCE;
        }
+       # workaround until anyevent supports disabling TLS 1.3 directly
+       if (exists($self->{ssl}->{tlsv1_3}) && !$self->{ssl}->{tlsv1_3}) {
+           $tls_ctx_flags |= &Net::SSLeay::OP_NO_TLSv1_3;
+       }
+
 
        $self->{tls_ctx} = AnyEvent::TLS->new(%{$self->{ssl}});
        Net::SSLeay::CTX_set_options($self->{tls_ctx}->{ctx}, $tls_ctx_flags);
-       Net::SSLeay::CTX_set_ciphersuites($self->{tls_ctx}->{ctx}, $ciphersuites) if defined($ciphersuites);
+       if (defined($ciphersuites)) {
+           warn "Failed to set TLS 1.3 ciphersuites '$ciphersuites'\n"
+               if !Net::SSLeay::CTX_set_ciphersuites($self->{tls_ctx}->{ctx}, $ciphersuites);
+       }
     }
 
     if ($self->{spiceproxy}) {