]> git.proxmox.com Git - pve-http-server.git/blobdiff - PVE/APIServer/AnyEvent.pm
add some inline docs
[pve-http-server.git] / PVE / APIServer / AnyEvent.pm
index 31380ab6bad83d7ce5226741300f9e7dbe7e33fe..acf43a0347345b16c3a7ef3e400ff852b8dee0d4 100755 (executable)
@@ -8,6 +8,7 @@ use POSIX qw(strftime EINTR EAGAIN);
 use Fcntl;
 use IO::File;
 use File::stat qw();
+use File::Find;
 use MIME::Base64;
 use Digest::MD5;
 use Digest::SHA;
@@ -237,7 +238,7 @@ sub response {
     $res .= $content if $content;
 
     $self->log_request($reqstate, $reqstate->{request});
-    
+
     if ($delay && $delay > 0) {
        my $w; $w = AnyEvent->timer(after => $delay, cb => sub {
            undef $w; # delete reference
@@ -289,7 +290,7 @@ sub send_file_start {
                die "$!\n";
            my $stat = File::stat::stat($fh) ||
                die "$!\n";
-           
+
            my $mtime = $stat->mtime;
 
            if (my $ifmod = $r->header('if-modified-since')) {
@@ -351,9 +352,9 @@ sub websocket_proxy {
        }
 
        tcp_connect $remhost, $remport, sub {
-           my ($fh) = @_ 
+           my ($fh) = @_
                or die "connect to '$remhost:$remport' failed: $!";
-       
+
            print "$$: CONNECTed to '$remhost:$remport'\n" if $self->{debug};
 
            $reqstate->{proxyhdl} = AnyEvent::Handle->new(
@@ -380,7 +381,7 @@ sub websocket_proxy {
 
            my $proxyhdlreader = sub {
                my ($hdl) = @_;
-               
+
                my $len = length($hdl->{rbuf});
                my $data = substr($hdl->{rbuf}, 0, $len, '');
 
@@ -399,10 +400,10 @@ sub websocket_proxy {
                if ($payload_len <= 125) {
                    $string .= pack 'C', $payload_len;
                } elsif ($payload_len <= 0xffff) {
-                   $string .= pack 'C', 126; 
+                   $string .= pack 'C', 126;
                    $string .= pack 'n', $payload_len;
                } else {
-                   $string .= pack 'C', 127; 
+                   $string .= pack 'C', 127;
                    $string .= pack 'Q>', $payload_len;
                }
                $string .= $payload;
@@ -442,13 +443,13 @@ sub websocket_proxy {
                    $offset += 8;
                }
 
-               die "received too large websocket frame (len = $payload_len)\n" 
+               die "received too large websocket frame (len = $payload_len)\n"
                    if ($payload_len > $max_payload_size) || ($payload_len < 0);
 
                return if $len < ($offset + 4 + $payload_len);
 
                my $data = substr($hdl->{rbuf}, 0, $len, ''); # now consume data
-               
+
                my @mask = (unpack('C', substr($data, $offset+0, 1)),
                            unpack('C', substr($data, $offset+1, 1)),
                            unpack('C', substr($data, $offset+2, 1)),
@@ -626,7 +627,7 @@ sub decode_urlencoded {
            $res->{$k} = "$old\0$v";
        } else {
            $res->{$k} = $v;
-       }       
+       }
     }
     return $res;
 }
@@ -666,8 +667,6 @@ sub handle_api2_request {
 
        #print Dumper($upload_state) if $upload_state;
 
-       my $rpcenv = $self->{rpcenv};
-
        my $params;
 
        if ($upload_state) {
@@ -680,14 +679,10 @@ sub handle_api2_request {
 
        my $clientip = $reqstate->{peer_host};
 
-       $rpcenv->init_request();
-
        my $res = $self->rest_handler($clientip, $method, $rel_uri, $auth, $params);
 
        AnyEvent->now_update(); # in case somebody called sleep()
 
-       $rpcenv->set_user(undef); # clear after request
-
        my $upgrade = $r->header('upgrade');
        $upgrade = lc($upgrade) if $upgrade;
 
@@ -738,7 +733,9 @@ sub handle_api2_request {
            $delay = 0 if $delay < 0;
        }
 
-       my ($raw, $ct, $nocomp) = &$formatter($res, $res->{data}, $params, $path, $auth);
+       my $csrfgen_func = $self->can('generate_csrf_prevention_token');
+       my ($raw, $ct, $nocomp) = &$formatter($res, $res->{data}, $params, $path,
+                                             $auth, $csrfgen_func, $self->{title});
 
        my $resp;
        if (ref($raw) && (ref($raw) eq 'HTTP::Response')) {
@@ -762,9 +759,6 @@ sub handle_spice_proxy_request {
 
         die "Port $spiceport is not allowed" if ($spiceport < 61000 || $spiceport > 61099);
 
-       my $rpcenv = $self->{rpcenv};
-       $rpcenv->init_request();
-
        my $clientip = $reqstate->{peer_host};
        my $r = $reqstate->{request};
 
@@ -789,7 +783,7 @@ sub handle_spice_proxy_request {
        my $remport = $remip ? 3128 : $spiceport;
 
        tcp_connect $remhost, $remport, sub {
-           my ($fh) = @_ 
+           my ($fh) = @_
                or die "connect to '$remhost:$remport' failed: $!";
 
            print "$$: CONNECTed to '$remhost:$remport'\n" if $self->{debug};
@@ -865,7 +859,7 @@ sub handle_spice_proxy_request {
                $reqstate->{proxyhdl}->push_write($header);
                $reqstate->{proxyhdl}->push_read(line => sub {
                    my ($hdl, $line) = @_;
-                   
+
                    if ($line =~ m!^$proto 200 OK$!) {
                        &$startproxy();
                    } else {
@@ -893,7 +887,7 @@ sub handle_request {
 
     eval {
        my $r = $reqstate->{request};
-       
+
        # disable timeout on handle (we already have all data we need)
        # we re-enable timeout in response()
        $reqstate->{hdl}->timeout(0);
@@ -989,14 +983,14 @@ sub file_upload_multipart {
                }
            } else {
                my $len = length($hdl->{rbuf});
-               substr($hdl->{rbuf}, 0, $len - $rstate->{maxheader}, '') 
+               substr($hdl->{rbuf}, 0, $len - $rstate->{maxheader}, '')
                    if $len > $rstate->{maxheader}; # skip garbage
            }
        } 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 - $!" 
+               die "write to temporary file failed - $!"
                    if syswrite($rstate->{outfh}, $rest) != $len;
                $rstate->{ctx}->add($rest);
                $rstate->{params}->{filename} = $rstate->{filename};
@@ -1008,7 +1002,7 @@ sub file_upload_multipart {
                my $wlen = $len - $rstate->{boundlen};
                if ($wlen > 0) {
                    my $data = substr($hdl->{rbuf}, 0, $wlen, '');
-                   die "write to temporary file failed - $!" 
+                   die "write to temporary file failed - $!"
                        if syswrite($rstate->{outfh}, $data) != $wlen;
                    $rstate->{bytes} += $wlen;
                    $rstate->{ctx}->add($data);
@@ -1028,7 +1022,7 @@ sub file_upload_multipart {
                    $rstate->{phase} = -1; # skip
                }
            }
-       } else { # skip 
+       } else { # skip
            my $len = length($hdl->{rbuf});
            substr($hdl->{rbuf}, 0, $len, ''); # empty rbuf
        }
@@ -1036,15 +1030,15 @@ sub file_upload_multipart {
        $rstate->{read} += ($startlen - length($hdl->{rbuf}));
 
        if (!$rstate->{done} && ($rstate->{read} + length($hdl->{rbuf})) >= $rstate->{size}) {
-           $rstate->{done} = 1; # make sure we dont get called twice 
+           $rstate->{done} = 1; # make sure we dont get called twice
            if ($rstate->{phase} < 0 || !$rstate->{md5sum}) {
-               die "upload failed\n"; 
+               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: $rstate->{md5sum})", 
+               syslog('info', "multipart upload complete " .
+                      "(size: %d time: %ds rate: %.2fMiB/s md5sum: $rstate->{md5sum})",
                       $rstate->{bytes}, $elapsed, $rate);
                $self->handle_api2_request($reqstate, $auth, $method, $path, $rstate);
            }
@@ -1060,13 +1054,13 @@ sub parse_content_type {
     my ($ctype) = @_;
 
     my ($ct, @params) = split(/\s*[;,]\s*/o, $ctype);
-    
+
     foreach my $v (@params) {
        if ($v =~ m/^\s*boundary\s*=\s*(\S+?)\s*$/o) {
            return wantarray ? ($ct, $1) : $ct;
        }
     }
+
     return  wantarray ? ($ct) : $ct;
 }
 
@@ -1086,7 +1080,7 @@ sub parse_content_disposition {
            $filename =~ s/^"(.*)"$/$1/;
        }
     }
+
     return  wantarray ? ($disp, $name, $filename) : $disp;
 }
 
@@ -1094,7 +1088,7 @@ my $tmpfile_seq_no = 0;
 
 sub get_upload_filename {
     # choose unpredictable tmpfile name
-  
+
     $tmpfile_seq_no++;
     return "/var/tmp/pveupload-" . Digest::MD5::md5_hex($tmpfile_seq_no . time() . $$);
 }
@@ -1185,14 +1179,9 @@ sub unshift_read_header {
                        return;
                    }
 
-                   my $rpcenv = $self->{rpcenv};
-                   # set environment variables
-                   $rpcenv->set_user(undef);
-                   $rpcenv->set_language('C');
-                   $rpcenv->set_client_ip($reqstate->{peer_host});
-
                    eval {
-                       $auth = $self->auth_handler($method, $rel_uri, $ticket, $token);
+                       $auth = $self->auth_handler($method, $rel_uri, $ticket, $token,
+                                                   $reqstate->{peer_host});
                    };
                    if (my $err = $@) {
                        # always delay unauthorized calls by 3 seconds
@@ -1229,7 +1218,7 @@ sub unshift_read_header {
                    my ($ct, $boundary) = parse_content_type($ctype) if $ctype;
 
                    if ($auth->{isUpload} && !$self->{trusted_env}) {
-                       die "upload 'Content-Type '$ctype' not implemented\n" 
+                       die "upload 'Content-Type '$ctype' not implemented\n"
                            if !($boundary && $ct && ($ct eq 'multipart/form-data'));
 
                        die "upload without content length header not supported" if !$len;
@@ -1422,7 +1411,7 @@ sub wait_end_loop {
 
 sub check_host_access {
     my ($self, $clientip) = @_;
-    
+
     my $cip = Net::IP->new($clientip);
 
     my $match_allow = 0;
@@ -1568,7 +1557,7 @@ sub new {
 
     my $class = ref($this) || $this;
 
-    foreach my $req (qw(base_handler_class socket lockfh lockfile)) {
+    foreach my $req (qw(socket lockfh lockfile)) {
        die "misssing required argument '$req'" if !defined($args{$req});
     }
 
@@ -1576,6 +1565,13 @@ sub new {
 
     $self->{cookie_name} //= 'PVEAuthCookie';
     $self->{base_uri} //= "/api2";
+    $self->{dirs} //= {};
+    $self->{title} //= 'API Inspector';
+
+    my $base = '/usr/share/libpve-http-server-perl';
+    add_dirs($self->{dirs}, '/css/' => "$base/css/");
+    add_dirs($self->{dirs}, '/js/' => "$base/js/");
+    add_dirs($self->{dirs}, '/fonts/' => "$base/fonts/");
 
     # init inotify
     PVE::INotify::inotify_init();
@@ -1596,8 +1592,8 @@ sub new {
 
     if ($self->{ssl}) {
        $self->{tls_ctx} = AnyEvent::TLS->new(%{$self->{ssl}});
-       # TODO : openssl >= 1.0.2 supports SSL_CTX_set_ecdh_auto to select a curve depending on 
-       # server and client availability from SSL_CTX_set1_curves. 
+       # TODO : openssl >= 1.0.2 supports SSL_CTX_set_ecdh_auto to select a curve depending on
+       # server and client availability from SSL_CTX_set1_curves.
        # that way other curves like 25519 can be used.
        # openssl 1.0.1 can only support 1 curve at a time.
        my $curve = Net::SSLeay::OBJ_txt2nid('prime256v1');
@@ -1648,6 +1644,24 @@ sub new {
     return $self;
 }
 
+# static helper to add directory including all subdirs
+# This can be used to setup $self->{dirs}
+sub add_dirs {
+    my ($result_hash, $alias, $subdir) = @_;
+
+    $result_hash->{$alias} = $subdir;
+
+    my $wanted = sub {
+       my $dir = $File::Find::dir;
+       if ($dir =~m!^$subdir(.*)$!) {
+           my $name = "$alias$1/";
+           $result_hash->{$name} = "$dir/";
+       }
+    };
+
+    find({wanted => $wanted, follow => 0, no_chdir => 1}, $subdir);
+}
+
 # abstract functions - subclass should overwrite/implement them
 
 sub verify_spice_connect_url {
@@ -1658,8 +1672,15 @@ sub verify_spice_connect_url {
     #return ($vmid, $node, $port);
 }
 
+# formatters can call this when the generate a new page
+sub generate_csrf_prevention_token {
+    my ($username) = @_;
+
+    return undef; # do nothing by default
+}
+
 sub auth_handler {
-    my ($self, $method, $rel_uri, $ticket, $token) = @_;
+    my ($self, $method, $rel_uri, $ticket, $token, $peer_host) = @_;
 
     die "implement me";
 
@@ -1673,14 +1694,33 @@ sub auth_handler {
     #};
 }
 
-
 sub rest_handler {
     my ($self, $clientip, $method, $rel_uri, $auth, $params) = @_;
 
+    # please do not raise exceptions here (always return a result).
+
     return {
        status => HTTP_NOT_IMPLEMENTED,
        message => "Method '$method $rel_uri' not implemented",
     };
+
+    # this should return the following properties, which
+    # are then passed to the Formatter
+
+    # status: HTTP status code
+    # message: Error message
+    # errors: more detailed error hash (per parameter)
+    # info: reference to JSON schema definition - useful to format output
+    # data: result data
+
+    # total: additional info passed to output
+    # changes:  additional info passed to output
+
+    # if you want to proxy the request to another node return this
+    # { proxy => $remip, proxynode => $node, proxy_params => $params };
+
+    # to pass the request to the local priviledged daemon use:
+    # { proxy => 'localhost' , proxy_params => $params };
 }
 
 sub check_cert_fingerprint {