[pve-devel] r4855 - in pve-manager/pve2: . bin debian lib/PVE lib/PVE/API2 www/manager

svn-commits at proxmox.com svn-commits at proxmox.com
Thu Jul 1 11:07:12 CEST 2010


Author: dietmar
Date: 2010-07-01 09:07:12 +0000 (Thu, 01 Jul 2010)
New Revision: 4855

Added:
   pve-manager/pve2/bin/pvesh
Modified:
   pve-manager/pve2/ChangeLog
   pve-manager/pve2/README
   pve-manager/pve2/bin/Makefile.am
   pve-manager/pve2/bin/Makefile.in
   pve-manager/pve2/debian/control.in
   pve-manager/pve2/lib/PVE/API2.pm
   pve-manager/pve2/lib/PVE/API2/Cluster.pm
   pve-manager/pve2/lib/PVE/API2/Makefile.am
   pve-manager/pve2/lib/PVE/API2/Storage.pm
   pve-manager/pve2/lib/PVE/API2/VM.pm
   pve-manager/pve2/lib/PVE/APIDaemon.pm
   pve-manager/pve2/lib/PVE/Config.pm
   pve-manager/pve2/lib/PVE/JSONSchema.pm
   pve-manager/pve2/lib/PVE/REST.pm
   pve-manager/pve2/lib/PVE/RESTHandler.pm
   pve-manager/pve2/www/manager/LoginWindow.js
   pve-manager/pve2/www/manager/PVECache.js
   pve-manager/pve2/www/manager/PVEUtils.js
   pve-manager/pve2/www/manager/index.pl
Log:
done more work on the REST API


Modified: pve-manager/pve2/ChangeLog
===================================================================
--- pve-manager/pve2/ChangeLog	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/ChangeLog	2010-07-01 09:07:12 UTC (rev 4855)
@@ -1,3 +1,7 @@
+2010-07-01  Proxmox Support Team  <support at proxmox.com>
+
+	* bin/pvesh: experimental command line tool
+
 2010-06-25  Proxmox Support Team  <support at proxmox.com>
 
 	* lib/PVE/REST.pm (proxy_handler): impl. PUT/DELETE

Modified: pve-manager/pve2/README
===================================================================
--- pve-manager/pve2/README	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/README	2010-07-01 09:07:12 UTC (rev 4855)
@@ -37,6 +37,7 @@
   * vnc client: the java implementation takes long time to load
 	- can we speedup that?
 	- test http://www.wizhelp.com/flashlight-vnc/ with vncterm
+	- test http://novnc.com/novnc/ novnc
 	- provide custom controls to select 'cdrom'?
 
   * generate appliances

Modified: pve-manager/pve2/bin/Makefile.am
===================================================================
--- pve-manager/pve2/bin/Makefile.am	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/bin/Makefile.am	2010-07-01 09:07:12 UTC (rev 4855)
@@ -3,6 +3,7 @@
 SUBDIRS = init.d cron test
 
 bin_SCRIPTS =  			\
+	pvesh			\
 	pveam			\
 	pveca 			\
 	pvecert			\

Modified: pve-manager/pve2/bin/Makefile.in
===================================================================
--- pve-manager/pve2/bin/Makefile.in	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/bin/Makefile.in	2010-07-01 09:07:12 UTC (rev 4855)
@@ -216,6 +216,7 @@
 top_srcdir = @top_srcdir@
 SUBDIRS = init.d cron test
 bin_SCRIPTS = \
+	pvesh			\
 	pveam			\
 	pveca 			\
 	pvecert			\

Added: pve-manager/pve2/bin/pvesh
===================================================================
--- pve-manager/pve2/bin/pvesh	                        (rev 0)
+++ pve-manager/pve2/bin/pvesh	2010-07-01 09:07:12 UTC (rev 4855)
@@ -0,0 +1,354 @@
+#!/usr/bin/perl -w
+
+
+# NOTE: this is just an experimental prototype
+
+# TODO:
+# implement nice help messages (use JSON-Schema to generate them)
+# implement auto-completion
+
+use strict;
+use PVE::API2;
+use Term::ReadLine;
+use Getopt::Long;
+use File::Basename;
+use HTTP::Status qw(:constants :is status_message);
+use Text::ParseWords;
+use PVE::JSONSchema;
+use JSON;
+ 
+use Data::Dumper; # fixme: remove
+
+my $basedir = '/api2/json';
+
+my $cdir = '';
+
+print "entering PVE shell - type 'help' for help\n";
+
+my $term = new Term::ReadLine ('pvesh');
+
+sub abs_path {
+    my ($current, $path) = @_;
+
+    my $ret = $current;
+
+    return $current if !defined($path);
+
+    $ret = '' if $path =~ m|^\/|;
+
+    foreach my $d (split (/\/+/ , $path)) {
+	if ($d eq '.') {
+	    next;
+	} elsif ($d eq '..') {
+	    $ret = dirname($ret);
+	    $ret = '' if $ret eq '.';
+	} else {
+	    $ret = "$ret/$d";
+	}
+    }
+
+    $ret =~ s|\/+|\/|g;
+    $ret =~ s|^\/||;
+    $ret =~ s|\/$||;
+
+    return $ret;
+}
+
+sub call_handler {
+    my ($handler, $info, $dir, $params) = @_;
+
+    my $conn = {
+	abs_uri => "$basedir/$dir",
+	rel_uri => $dir,
+	user => 'root', # fixme ?
+	params => $params,
+    };
+
+    my $resp = {}; 
+    my $status = $handler->handle($info, $conn, $resp);
+
+    #print "GOT $status " . Dumper($resp);
+
+    if ($status && ($status != HTTP_OK)) {
+	if ($resp->{errors}) {
+	    foreach my $e (keys %{$resp->{errors}}) {
+		warn "$e: $resp->{errors}->{$e}\n";
+	    }
+	}
+	die "$status $resp->{message}\n" if $resp->{message};
+	die status_message($status) . "\n";
+    }
+
+
+    return $resp->{data};
+}
+
+sub read_password {
+    my $attribs = $term->Attribs;
+    my $old = $attribs->{redisplay_function};
+    $attribs->{redisplay_function} = $attribs->{shadow_redisplay};
+    my $input = $term->readline('password: ');
+    $attribs->{redisplay_function} = $old;
+    return $input;
+}
+
+sub get_options {
+    my ($info, $args) = @_;
+
+    if (!$info->{parameters} || !$info->{parameters}->{properties}) {
+	die "too many arguments\n"
+	    if scalar(@$args) != 0;
+	return {};
+    }
+
+    my @getopt = ();
+    foreach my $prop (keys %{$info->{parameters}->{properties}}) {
+	my $pd = $info->{parameters}->{properties}->{$prop};
+
+	#print "PROP " . Dumper($pd) . "\n";
+
+	# we do not accept plain password on input line, instead
+	# we turn this into a boolean option and ask for password below
+	# using read_password() (for security reasons).
+	if ($pd->{type} eq 'boolean' || $prop eq 'password') {
+	    push @getopt, "$prop";
+	} else {
+	    push @getopt, "$prop=s";
+	}
+    }
+
+    my $opts = {};
+    die "unable to parse option\n"
+	if !Getopt::Long::GetOptionsFromArray($args, $opts, @getopt);
+    
+    die "too many arguments\n"
+	if scalar(@$args) != 0;
+
+    if (my $pd = $info->{parameters}->{properties}->{password}) {
+	if ($pd->{type} ne 'boolean') {
+	    if ($opts->{password} || !$pd->{optional}) {
+		$opts->{password} = read_password(); 
+	    }
+	}
+    }
+
+    return $opts;
+}
+
+sub create_entry {
+    my ($dir, $args) = @_;
+
+    my $stack = [ split(/\/+/, $dir) ];
+    my ($handler, $info) = PVE::API2->find_handler('POST', $stack);
+    if (!$handler || !$info) {
+	die "no 'create' handler for '$dir'\n";
+    }
+
+    my $opts = get_options($info, $args);
+
+    # print "CREATE $dir " . Dumper($opts) . "\n";
+
+    my $data = call_handler($handler, $info, $dir, $opts);
+
+}
+
+sub get_entry {
+    my ($dir, $args) = @_;
+
+    my $stack = [ split(/\/+/, $dir) ];
+    my ($handler, $info) = PVE::API2->find_handler('GET', $stack);
+    if (!$handler || !$info) {
+	die "no 'get' handler for '$dir'\n";
+    }
+
+    my $opts = get_options($info, $args);
+
+    # print "GET $dir " . Dumper($opts) . "\n";
+
+    my $data = call_handler($handler, $info, $dir, $opts);
+
+    print to_json($data, {allow_nonref => 1, canonical => 1, pretty => 1 });
+}
+
+sub update_entry {
+    my ($dir, $args) = @_;
+
+    my $stack = [ split(/\/+/, $dir) ];
+    my ($handler, $info) = PVE::API2->find_handler('PUT', $stack);
+    if (!$handler || !$info) {
+	die "no 'update' handler for '$dir'\n";
+    }
+
+    my $opts = get_options($info, $args);
+
+    print "PUT $dir " . Dumper($opts) . "\n";
+
+    my $data = call_handler($handler, $info, $dir, $opts);
+
+    print to_json($data, {allow_nonref => 1, canonical => 1, pretty => 1});
+}
+
+sub delete_entry {
+    my ($dir) = @_;
+
+    my $stack = [ split(/\/+/, $dir) ];
+    my ($handler, $info) = PVE::API2->find_handler('DELETE', $stack);
+    if (!$handler || !$info) {
+	die "no 'delete' handler for '$dir'\n";
+    }
+    
+    # print "DELETE $dir\n";
+
+    my $data = call_handler($handler, $info, $dir, {});
+}
+
+sub test_dir {
+    my ($dir) = @_;
+
+    my $stack = [ split(/\/+/, $dir) ];
+    my ($handler, $info) = PVE::API2->find_handler('GET', $stack);
+    return undef if !$handler || !$info;
+
+    my $found =  PVE::JSONSchema::method_get_index_link($info);
+
+    return wantarray ? ($handler, $info) : 1 if $found;
+
+    return undef;
+}
+
+sub list_dir {
+    my ($dir, $args) = @_;
+
+    #print "LIST $dir\n";
+
+    my ($handler, $info) = test_dir($dir);
+    if (!$handler || !$info) {
+	die "no such directory\n";
+    }
+
+    my $params = get_options($info, $args);
+
+    # print "LIST $dir " . Dumper($params) . "\n";
+
+    my $data = call_handler($handler, $info, $dir, $params);
+
+    my $lnk = PVE::JSONSchema::method_get_index_link($info);
+    if ($lnk && $data) {
+	my $href = $lnk->{href};
+	if ($href =~ m/^\{(\S+)\}$/) {
+	    my $prop = $1;
+
+	    foreach my $elem (sort {$a->{$prop} cmp $b->{$prop}} @$data) {
+		next if !ref($elem);
+
+		if (defined(my $value = $elem->{$prop})) {
+		    if ($value ne '') {
+			my $tt = $prop eq 'subdir' ? 'D' : '-';
+			if (scalar(keys %$elem) > 1) {
+			    my $tv = to_json($elem, {allow_nonref => 1, canonical => 1});
+			    print "$tt $value $tv\n";
+			} else {
+			    print "$tt $value\n";
+			}
+		    }
+		}
+	    }
+	}
+    }
+
+    #print Dumper($data);
+}
+
+sub pve_command {
+    my $input = shift;
+
+    my $args = [ shellwords($input) ];
+
+
+    my $cmd = shift @$args;
+
+    #print "CMD: $cmd\n";
+    #print "ARGS: " . join (' ', @$args) . "\n";
+    
+    if ($cmd eq 'cd') {
+
+	my $path =  shift @$args;
+
+	die "usage: cd [dir]\n" if scalar(@$args);
+
+	if (!defined($path)) {
+	    $cdir = '';
+	    return;
+	} else {
+	    my $new_dir = abs_path($cdir, $path);
+	    die "no such directory\n" if !test_dir($new_dir);
+	    $cdir = $new_dir;
+	}
+
+    } elsif ($cmd eq 'help') {
+
+	die "implement me!";
+
+    } elsif ($cmd eq 'ls') {
+	my $path;
+	if (scalar(@$args) && $args->[0] !~ m/^\-/)  {
+	    $path = shift @$args;
+	}
+
+	list_dir(abs_path($cdir, $path), $args);
+
+    } elsif ($cmd eq 'get') {
+
+	my $path;
+	if (scalar(@$args) && $args->[0] !~ m/^\-/)  {
+	    $path = shift @$args;
+	}
+
+	get_entry(abs_path($cdir, $path), $args);
+
+    } elsif ($cmd eq 'create') {
+
+	my $path;
+	if (scalar(@$args) && $args->[0] !~ m/^\-/)  {
+	    $path = shift @$args;
+	}
+
+	create_entry(abs_path($cdir, $path), $args);
+
+    } elsif ($cmd eq 'delete') {
+
+	my $path = shift @$args;
+
+	die "usage: delete [path]\n" if scalar(@$args);
+
+	delete_entry(abs_path($cdir, $path));
+
+    } elsif ($cmd eq 'set') {
+
+	my $path;
+	if (scalar(@$args) && $args->[0] !~ m/^\-/)  {
+	    $path = shift @$args;
+	}
+
+	update_entry(abs_path($cdir, $path), $args);
+
+    } else {
+	die "unknown command '$cmd'\n";
+    }
+
+}
+
+my $input;
+while (defined ($input = $term->readline("pve:/$cdir> "))) {
+    chomp $input;
+
+    next if $input =~ m/^\s*$/;
+
+    if ($input =~ m/^\s*q(uit)?\s*$/) {
+	exit (0);
+    }
+    eval {
+	pve_command ($input);
+    };
+    print "ERROR: $@" if $@;
+}


Property changes on: pve-manager/pve2/bin/pvesh
___________________________________________________________________
Added: svn:executable
   + *

Modified: pve-manager/pve2/debian/control.in
===================================================================
--- pve-manager/pve2/debian/control.in	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/debian/control.in	2010-07-01 09:07:12 UTC (rev 4855)
@@ -3,7 +3,7 @@
 Section: admin
 Priority: optional
 Architecture: all
-Depends: perl5, libtimedate-perl, apache2-mpm-prefork, postfix (>= 2.2.8), libembperl-perl, libauthen-pam-perl, libintl-perl, libfilesys-smbclient-perl, rsync, libsoap-lite-perl, libapache-authcookie-perl, libgd-graph-perl, libapache2-request-perl, atsar, libjson-perl, libfile-sync-perl, libdigest-sha1-perl, vncterm, qemu-server (>= 1.1-1), libwww-perl, wget, libnet-dns-perl, vlan, ifenslave-2.6 (>= 1.1.0-10), liblinux-inotify2-perl, debconf (>= 0.5) | debconf-2.0, libjs-prototype (>= 1.6.0.3-1), netcat-traditional, libpve-storage-perl, libterm-readline-gnu-perl, libhttp-request-params-perl
+Depends: perl5, libtimedate-perl, apache2-mpm-prefork, postfix (>= 2.2.8), libembperl-perl, libauthen-pam-perl, libintl-perl, libfilesys-smbclient-perl, rsync, libsoap-lite-perl, libapache-authcookie-perl, libgd-graph-perl, libapache2-request-perl, atsar, libjson-perl, libfile-sync-perl, libdigest-sha1-perl, vncterm, qemu-server (>= 1.1-1), libwww-perl, wget, libnet-dns-perl, vlan, ifenslave-2.6 (>= 1.1.0-10), liblinux-inotify2-perl, debconf (>= 0.5) | debconf-2.0, libjs-prototype (>= 1.6.0.3-1), netcat-traditional, libpve-storage-perl, libterm-readline-gnu-perl, libhttp-request-params-perl, libpve-access-control
 Conflicts: netcat-openbsd
 Maintainer: Proxmox Support Team <support at proxmox.com>
 Description: The Proxmox Virtul Environment

Modified: pve-manager/pve2/lib/PVE/API2/Cluster.pm
===================================================================
--- pve-manager/pve2/lib/PVE/API2/Cluster.pm	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/lib/PVE/API2/Cluster.pm	2010-07-01 09:07:12 UTC (rev 4855)
@@ -16,13 +16,26 @@
     match_re => [], 
     method => 'GET',
     description => "Cluster node index.",
-    parameters => {},
-    returns => {},
+    parameters => {
+    	additionalProperties => 0,
+	properties => {},
+    },
+     returns => {
+	type => 'array',
+	items => {
+	    type => "object",
+	    properties => {},
+	},
+	links => [
+	    { rel => 'index', href => "{name}" }, 
+	    ],
+    },
 });
-
 sub index {
-    my ($conn, $resp) = @_;
+    my ($conn, $resp, $param) = @_;
     
+    # fixme: this is just some test code
+
     my $ctime = int(time()/1);
     $ctime = 0;
 
@@ -42,11 +55,8 @@
 	    maxmem => 10
 	};
     }
-    $resp->{data} = {
-	result => $result,
-    };
 
-    return HTTP_OK;
+    return $result;
 }
 
 1;

Modified: pve-manager/pve2/lib/PVE/API2/Makefile.am
===================================================================
--- pve-manager/pve2/lib/PVE/API2/Makefile.am	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/lib/PVE/API2/Makefile.am	2010-07-01 09:07:12 UTC (rev 4855)
@@ -3,6 +3,8 @@
 SUBDIRS=
 
 pvelib_DATA = 			\
+	AccessControl.pm	\
+	User.pm			\
 	Storage.pm		\
 	Cluster.pm		\
 	VM.pm

Modified: pve-manager/pve2/lib/PVE/API2/Storage.pm
===================================================================
--- pve-manager/pve2/lib/PVE/API2/Storage.pm	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/lib/PVE/API2/Storage.pm	2010-07-01 09:07:12 UTC (rev 4855)
@@ -4,9 +4,12 @@
 use warnings;
 
 use PVE::SafeSyslog;
-use Apache2::Const qw(:http);
-use JSON;
+use PVE::Config;
+use PVE::Storage;
+use HTTP::Status qw(:constants);
 
+use Data::Dumper; # fixme: remove
+
 use PVE::RESTHandler;
 
 use base qw(PVE::RESTHandler);
@@ -16,41 +19,37 @@
     match_re => [], 
     method => 'GET',
     description => "Storage index.",
-    parameters => {},
-    returns => {},
+    parameters => {
+    	additionalProperties => 0,
+	properties => {},
+    },
+    returns => {
+	type => 'array',
+	items => {
+	    type => "object",
+	    properties => {},
+	},
+	links => [
+	    { rel => 'index', href => "{name}" }, 
+	    ],
+    },
 });
-
 sub index {
-    my ($conn, $resp) = @_;
+    my ($conn, $resp, $param) = @_;
 
-    $resp->{data} = {
-	result => [
-	    { name => 'local' , node => 'node-1', disk => 1024*1024*1024*1024*1, maxdisk => 1024*1024*1024*1024*24},
-	    { name => 'store-1', shared => 1 },
-	    ],
-    };
+    my $cfg = PVE::Config::read_file ("storagecfg");
 
-    return HTTP_OK;
-}
+    my @sids =  PVE::Storage::storage_ids ($cfg);
 
-sub create {
+    my $res = [];
+    foreach my $storeid (@sids) {
+	my $scfg =  PVE::Storage::storage_config ($cfg, $storeid);
+	push @$res, { name => $storeid, type => $scfg->{type}, shared => $scfg->{shared} || 0};
+    }
 
-     return HTTP_OK;
-}
+    # $resp->{digest} = $cfg->{digest}; # fixme: how do we handle that
 
-sub read {
-
-     return HTTP_OK;
+    return $res;
 }
 
-sub write {
-
-     return HTTP_OK;
-}
-
-sub delete {
-
-     return HTTP_OK;
-}
-
 1;

Modified: pve-manager/pve2/lib/PVE/API2/VM.pm
===================================================================
--- pve-manager/pve2/lib/PVE/API2/VM.pm	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/lib/PVE/API2/VM.pm	2010-07-01 09:07:12 UTC (rev 4855)
@@ -16,12 +16,23 @@
     match_re => [], 
     method => 'GET',
     description => "Virtual machine index.",
-    parameters => {},
-    returns => {},
+    parameters => {
+    	additionalProperties => 0,
+	properties => {},
+    },
+    returns => {
+	type => 'array',
+	items => {
+	    type => "object",
+	    properties => {},
+	},
+	links => [
+	    { rel => 'index', href => "{id}" }, 
+	    ],
+    },
 });
-
 sub index {
-    my ($conn, $resp) = @_;
+    my ($conn, $resp, $param) = @_;
 
     my $ctime = int(time()/3);
     $ctime = 0;
@@ -44,32 +55,7 @@
 	push @$result, { id => $vmid, name => "VM $vmid", node => "node-$i" , storage => "store-$i", cpu => $cpu, maxcpu => 2};
     }
     
-
-    $resp->{data} = {
-	result => $result,
-    };
-
-    return HTTP_OK;
+    return $result;
 }
 
-sub create {
-
-     return HTTP_OK;
-}
-
-sub read {
-
-     return HTTP_OK;
-}
-
-sub write {
-
-     return HTTP_OK;
-}
-
-sub delete {
-
-     return HTTP_OK;
-}
-
 1;

Modified: pve-manager/pve2/lib/PVE/API2.pm
===================================================================
--- pve-manager/pve2/lib/PVE/API2.pm	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/lib/PVE/API2.pm	2010-07-01 09:07:12 UTC (rev 4855)
@@ -5,7 +5,6 @@
 
 use Apache2::Const qw(:http);
 use PVE::RESTHandler;
-use Data::Dumper; # fixme: remove
 
 use base qw(PVE::RESTHandler);
 
@@ -25,38 +24,32 @@
 });
 
 __PACKAGE__->register_method ({
+    subclass => "PVE::API2::AccessControl",  
+    match_re => [ 'access' ],
+});
+
+__PACKAGE__->register_method ({
     name => 'index', 
-    # protected => 1, # fixme: remove
     match_re => [], 
     method => 'GET',
     description => "Directory index.",
     parameters => {
-	type => "object",
-	properties => {
-	    p1 => { 
-		type => 'string',
-		description => "This is parameter p1",
-		optional => 1,
-		pattern => "[a-z]+",
-		default => "abc",
-	    }, 
-	},
+	additionalProperties => 0,
+	properties => {},
     },
     returns => {
 	type => 'array',
 	items => {
 	    type => "object",
 	    properties => {
-		node => { type => 'string' },
+		subdir => { type => 'string' },
 	    },
 	},
-	links => [
-	    { href => "{node}" }, 
-	    ],
+	links => [ { rel => 'index', href => "{subdir}" } ],
     },
 }); 
 sub index {
-    my ($conn, $resp) = @_;
+    my ($conn, $resp, $param) = @_;
     
     my $res = [];
 
@@ -67,13 +60,10 @@
 
 	my $subpath = $info->{match_re}->[0];
 
-	push @$res, { node => $subpath };
+	push @$res, { subdir => $subpath };
     }
 
-
-    $resp->{data} = $res;
-
-    return HTTP_OK;
+    return $res;
 }
 
 1;

Modified: pve-manager/pve2/lib/PVE/APIDaemon.pm
===================================================================
--- pve-manager/pve2/lib/PVE/APIDaemon.pm	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/lib/PVE/APIDaemon.pm	2010-07-01 09:07:12 UTC (rev 4855)
@@ -230,42 +230,52 @@
 		    my $method =  $r->method();
 
 		    my $uri = $r->uri->path();
-
 		    syslog('info', "start $method $uri");
 
-		    my $headers = $r->headers;
+		    my ($rel_uri, $format) = PVE::REST::split_abs_uri($uri);
+		    if (!$format) {
 
-		    my $cookie = $headers->header('Cookie');
+			$c->send_error(HTTP_NOT_IMPLEMENTED);			
 
-		    my $ticket = PVE::REST::extract_auth_cookie($cookie);
+		    } else {
 
-		    my $parser = HTTP::Request::Params->new({req => $r});
-		    my $params = $parser->params;
+
+			my $headers = $r->headers;
+
+			my $cookie = $headers->header('Cookie');
+
+			my $ticket = PVE::REST::extract_auth_cookie($cookie);
+
+			my $parser = HTTP::Request::Params->new({req => $r});
+			my $params = $parser->params;
 		
-		    my $res = PVE::REST::rest_handler($method, $uri, $ticket, $params);
+			my $res = PVE::REST::rest_handler($method, $uri, $rel_uri, $ticket, $params);
 
-		    if ($res->{proxy}) {
+			if ($res->{proxy}) {
 
-			$res->{status} = 500;
-			$c->send_error($res->{status}, "proxy not allowed");
+			    $res->{status} = 500;
+			    $c->send_error($res->{status}, "proxy not allowed");
 
-		    } else {
+			} else {
 
-			my $response = HTTP::Response->new($res->{status});
-			$response->header("Content-Type" => 'application/json');
-			$response->header("Pragma", "no-cache");
+			    PVE::REST::prepare_response_data($format, $res);
+			    my ($raw, $ct) = PVE::REST::format_response_data($format, $res, $uri);
 
-			if ($res->{ticket}) {
-			    my $cookie = PVE::REST::create_auth_cookie($res->{ticket});
-			    $response->header("Set-Cookie" => $cookie);
+			    my $response = HTTP::Response->new($res->{status});
+			    $response->header("Content-Type" => $ct);
+			    $response->header("Pragma", "no-cache");
+
+			    if ($res->{ticket}) {
+				my $cookie = PVE::REST::create_auth_cookie($res->{ticket});
+				$response->header("Set-Cookie" => $cookie);
+			    }
+			    $response->content($raw);
+
+			    $c->send_response($response);
 			}
 
-			$response->content(to_json($res->{data}, {utf8 => 1,allow_nonref => 1}));
-			$c->send_response($response);
+			syslog('info', "end $method $uri ($res->{status})");
 		    }
-
-		    syslog('info', "end $method $uri ($res->{status})");
-
 		}
 		$rcount++;
 

Modified: pve-manager/pve2/lib/PVE/Config.pm
===================================================================
--- pve-manager/pve2/lib/PVE/Config.pm	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/lib/PVE/Config.pm	2010-07-01 09:07:12 UTC (rev 4855)
@@ -15,6 +15,7 @@
 use Linux::Inotify2;
 use PVE::QemuServer;
 use PVE::Storage;
+use PVE::AccessControl;
 
 my $ccache;
 my $ccachemap;
@@ -1667,6 +1668,8 @@
 	  \&read_root_dotforward,
 	  \&write_root_dotforward);
  
+add_file ('usercfg', "/etc/pve/user.cfg", 
+	  \&PVE::AccessControl::parse_config);
 
 # persistent counter implementation
 add_file ('pcounter', "/var/lib/pve-manager/pcounter", 

Modified: pve-manager/pve2/lib/PVE/JSONSchema.pm
===================================================================
--- pve-manager/pve2/lib/PVE/JSONSchema.pm	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/lib/PVE/JSONSchema.pm	2010-07-01 09:07:12 UTC (rev 4855)
@@ -42,10 +42,13 @@
 sub check_type {
     my ($path, $type, $value, $errors) = @_;
 
-    die "internal error" if !defined($value);
-
     return 1 if !$type;
 
+    if (!defined($value)) {
+	return 1 if $type eq 'null';
+	die "internal error" 
+    }
+
     if (my $tt = ref($type)) {
 	if ($tt eq 'ARRAY') {
 	    foreach my $t (@$type) {
@@ -196,6 +199,7 @@
     }
 
     if (!defined ($value)) {
+	return if $schema->{type} && $schema->{type} eq 'null';
 	if (!$schema->{optional}) {
 	    add_error($errors, $path, "property is missing and it is not optional");
 	}
@@ -563,4 +567,27 @@
 validate_schema($default_schema_noref);
 validate_schema($method_schema);
 
+# and now some utility methods (used by pve api)
+sub method_get_index_link {
+    my ($info) = @_;
+
+    return undef if !$info;
+
+    my $schema = $info->{returns};
+    return undef if !$schema || !$schema->{type} || $schema->{type} ne 'array';
+
+    my $links = $schema->{links};
+    return undef if !$links;
+
+    my $found;
+    foreach my $lnk (@$links) {
+	if ($lnk->{href} && $lnk->{rel} && ($lnk->{rel} eq 'index')) {
+	    $found = $lnk;
+	    last;
+	}
+    }
+
+    return $found;
+}
+
 1;

Modified: pve-manager/pve2/lib/PVE/REST.pm
===================================================================
--- pve-manager/pve2/lib/PVE/REST.pm	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/lib/PVE/REST.pm	2010-07-01 09:07:12 UTC (rev 4855)
@@ -5,12 +5,15 @@
 use PVE::SafeSyslog;
 use PVE::ConfigServer;
 use PVE::API2;
-use Apache2::Const qw(:common :http);
+use Apache2::Const;
 use CGI;
 use mod_perl2;
 use JSON;
 use LWP::UserAgent;
 use HTTP::Request::Common;
+use HTTP::Status qw(:constants :is status_message);
+use HTML::Entities;
+use PVE::JSONSchema;
 
 use Data::Dumper; # fixme: remove
 
@@ -63,16 +66,88 @@
     return cookie_string($cookie_name, $ticket);
 }
 
-sub send_response {
-    my($r, $data) = @_;
-    
-    $r->content_type ('application/json');
+sub format_response_data {
+    my($format, $res, $uri) = @_;
 
-    my $raw = to_json($data, {utf8 => 1, allow_nonref => 1});
-    $r->print($raw);
-    $r->err_headers_out()->add('Content-length' , length($raw));
+    my $data = $res->{data};
+    my $info = $res->{info};
+
+    my ($ct, $raw);
+
+    if ($format eq 'json') {
+	$ct = 'application/json';
+	$raw = to_json($data, {utf8 => 1, allow_nonref => 1});
+    } elsif ($format eq 'html') {
+	$ct = 'text/html';
+	$raw = "<html><body>";
+	if (!is_success($res->{status})) {
+	    my $msg = $res->{message} || '';
+	    $raw .= "<h1>ERROR $res->{status} $msg</h1>";
+	}
+	my $lnk = PVE::JSONSchema::method_get_index_link($info);
+	if ($lnk && $data && $data->{data} && is_success($res->{status})) {
+
+	    my $href = $lnk->{href};
+	    if ($href =~ m/^\{(\S+)\}$/) {
+		my $prop = $1;
+		$uri =~ s/\/+$//; # remove trailing slash
+		foreach my $elem (sort {$a->{$prop} cmp $b->{$prop}} @{$data->{data}}) {
+		    next if !ref($elem);
+
+		    if (defined(my $value = $elem->{$prop})) {
+			if ($value ne '') {
+			    if (scalar(keys %$elem) > 1) {
+				my $tv = to_json($elem, {allow_nonref => 1, canonical => 1});
+				$raw .= "<a href='$uri/$value'>$value</a> <pre>$tv</pre><br>";
+			    } else {
+				$raw .= "<a href='$uri/$value'>$value</a><br>";
+			    }
+			}
+		    }
+		}
+	    }
+	} else {
+	    $raw .= "<pre>";
+	    $raw .= encode_entities(to_json($data, {utf8 => 1, allow_nonref => 1, pretty => 1}));
+	    $raw .= "</pre>";
+	}
+	$raw .= "</body></html>";
+
+    } elsif ($format eq 'extjs') {
+	$ct = 'text/plain';
+	$raw = to_json($data, {utf8 => 1, allow_nonref => 1});
+    } else {
+	$ct = 'text/plain';
+	$raw = to_json($data, {utf8 => 1, allow_nonref => 1, pretty => 1});
+    }
+
+    return wantarray ? ($raw, $ct) : $raw;
 }
 
+sub prepare_response_data {
+    my ($format, $res) = @_;
+
+    my $success = 1;
+    my $new = {
+	data => $res->{data},
+    };
+    if (scalar(keys %{$res->{errors}})) {
+	$success = 0;
+	$new->{errors} = $res->{errors};
+    };
+
+    if ($format eq 'extjs') {
+	# HACK: extjs wants 'success' property instead of useful HTTP status codes
+	if (is_error($res->{status})) {
+	    $success = 0;
+	    $res->{status} = HTTP_OK;
+	}
+	$new->{success} = $success;
+    }
+
+    $res->{data} = $new;
+}
+
 sub proxy_handler {
     my($r, $host, $method, $abs_uri, $ticket, $params) = @_;
 
@@ -117,46 +192,34 @@
 	return $code;
     }
 
-    my $ct = $response->header('Content-Type');
-    if ($ct ne 'application/json') {
-	my $code = HTTP_BAD_GATEWAY;
-	$r->status_line("$code proxy got unexpected content type '$ct'");
-	return $code;
-    }
-
     if (my $cookie = $response->header("Set-Cookie")) {
 	$r->err_headers_out()->add("Set-Cookie" => $cookie);
     }
 
+    my $ct = $response->header('Content-Type');
+
     my $code = $response->code;
+    $r->status($code);
 
-    if ($code && ($code != OK)) {
-	$r->status($code);
-    }
-
     if (my $message = $response->message) {
 	$r->status_line("$code $message");
     }
 
-    $r->content_type ('application/json');
+    $r->content_type ($ct);
     my $raw = $response->decoded_content;
+    $r->print($raw);
     $r->err_headers_out()->add('Content-length' , length($raw));
 
-    $r->print($raw);
-
     syslog('info', "proxy end $method $host:$abs_uri ($code)");
 
-    return $code;
+    return OK;
 }
 
 sub rest_handler {
-    my ($method, $abs_uri, $ticket, $params) = @_;
+    my ($method, $abs_uri, $rel_uri, $ticket, $params) = @_;
  
     my $euid = $>;
    
-    my $rel_uri = $abs_uri;
-    $rel_uri =~ s/^\Q$baseuri\E//; 
-
     if ($rel_uri eq '/ticket') {
 	my $user = $params->{username} || '';
 	my $pw = $params->{password} || '';
@@ -166,8 +229,8 @@
 	#syslog('info', "ticket auth $user $pw");
 
 	if ($ticket = create_ticket($user, $pw)) {
-	    return { status => OK, ticket => $ticket, 
-		     data => { success => 1, ticket => $ticket }};
+	    return { status => HTTP_OK, ticket => $ticket, 
+		     data => { ticket => $ticket }};
 	}
 
 	return { status => HTTP_UNAUTHORIZED };
@@ -187,7 +250,6 @@
 	abs_uri => $abs_uri,
 	rel_uri => $rel_uri,
 	user => $username,
-	ticket => $ticket,
 	params => $params,
     };
 
@@ -199,21 +261,29 @@
 	};
     }
 
+    # fixme: not sure if we should do that here, because we can't proxy those
+    # methods to other hosts?
     return { proxy => 'localhost' } if $info->{protected} && ($euid != 0);
 
     my $resp = {};
- 
-    my $ret = { status => $handler->handle($info, $conn, $resp) };
+    $resp->{status} = $handler->handle($info, $conn, $resp);
+    $resp->{info} = $info; # useful to format output
 
     # fixme: update ticket if too old
-    # $ret->{ticket} = update_ticket($ticket);
+    # $resp->{ticket} = update_ticket($ticket);
 
-    $ret->{data} = $resp->{data} if $resp->{data};
-    $ret->{message} = $resp->{message} if $resp->{message};
-    
-    return $ret;
+    return $resp;
 }
 
+sub split_abs_uri {
+    my ($abs_uri) = @_;
+
+    my ($format, $rel_uri) = $abs_uri =~ m/^\Q$baseuri\E\/+(html|json|extjs)(\/.*)?$/;
+    $rel_uri = '/' if !$rel_uri;
+ 
+    return wantarray ? ($rel_uri, $format) : $rel_uri;
+}
+
 sub handler {
      my($r) = @_;
 
@@ -230,8 +300,12 @@
 
      $r->no_cache (1);
 
-     my $res = rest_handler($method, $r->uri, $ticket, $params);
+     my $abs_uri = $r->uri;
+     my ($rel_uri, $format) = split_abs_uri($abs_uri);
+     return HTTP_NOT_IMPLEMENTED if !$format;
 
+     my $res = rest_handler($method, $abs_uri, $rel_uri, $ticket, $params);
+
      if ($res->{proxy}) {
 	 if ($r->headers_in->{'PVEDisableProxy'}) {
 	     my $code = FORBIDDEN;
@@ -239,27 +313,30 @@
 	     $r->status_line("$code proxy loop detected - aborted");
 	     return $res->{status};	     
 	 } 
-	 return proxy_handler($r, $res->{proxy}, $method, $r->uri, $ticket, $params);
+	 return proxy_handler($r, $res->{proxy}, $method, $abs_uri, $ticket, $params);
      }
 
+     prepare_response_data($format, $res);
+
      if ($res->{ticket}) {
 	 my $cookie = create_auth_cookie($res->{ticket});
 	 $r->err_headers_out()->add("Set-Cookie" => $cookie);
      }
 
-     if ($res->{status} && ($res->{status} != OK)) {
-	 $r->status($res->{status});
-     } 
-
+     $r->status($res->{status} || HTTP_OK);
+ 
      if ($res->{message}) {
 	 $r->status_line("$res->{status} $res->{message}");
      }
 
-     send_response($r, $res->{data});
+     my ($raw, $ct) = format_response_data($format, $res, $abs_uri);
+     $r->content_type ($ct);
+     $r->print($raw);
+     $r->err_headers_out()->add('Content-length', length($raw));
     
      syslog('info', "perl handler end $res->{status}");
 
-     return $res->{status};
+     return OK;
 }
 
 1;

Modified: pve-manager/pve2/lib/PVE/RESTHandler.pm
===================================================================
--- pve-manager/pve2/lib/PVE/RESTHandler.pm	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/lib/PVE/RESTHandler.pm	2010-07-01 09:07:12 UTC (rev 4855)
@@ -5,9 +5,8 @@
 use PVE::SafeSyslog;
 use PVE::JSONSchema;
 use Data::Dumper; # fixme: remove
+use HTTP::Status qw(:constants :is);
 
-use Apache2::Const qw(:common :http);
-
 my $method_registry = {};
 
 sub register_method {
@@ -71,16 +70,13 @@
     };
     syslog('err', $@) if $@;
 
-    if (!$info) {
-	syslog('info', "Method $method not implemented");
-	return undef;
-    }
+    return undef if !$info;
 
     if (my $subh = $info->{subclass}) {
 	eval "require $subh;";
 
 	if ($@) {
-	    syslog ('err', "Method $method not implemented - missing subclass '$subh'");
+	    syslog ('err', "missing subclass '$subh': $@");
 	    return undef;
 	}
 
@@ -113,38 +109,37 @@
 	my $res = PVE::JSONSchema::validate($conn->{params}, $schema);
 	if (!$res->{valid}) {
 	    $resp->{status} = HTTP_BAD_REQUEST;
-	    $resp->{data} = { errors => $res->{errors} };
+	    $resp->{errors} = $res->{errors},
 	    return $resp->{status};
 	}
     }
 
     eval{
-	$resp->{status} = &$func($conn, $resp);
+	my $result = &$func($conn, $resp, $conn->{params});
+	$resp->{status} = HTTP_OK if !$resp->{status};
+	$resp->{data} = $result;
     };
     my $err = $@;
 
     if ($err) {
-	$resp->{message} = "SERVER ERROR: $err";
-	$resp->{status} = HTTP_INTERNAL_SERVER_ERROR;
-    } elsif (!$resp->{status}) {
-	$resp->{message} = "SERVER ERROR: no response status";
-	$resp->{status} = HTTP_INTERNAL_SERVER_ERROR;
+	$resp->{message} = $err;
+
+	$resp->{status} = HTTP_BAD_REQUEST
+	    if !($resp->{status} && is_error($resp->{status}));
     }
 
     # fixme: this is only to be safe
-    if (my $schema = $info->{returns}) {
+    if (!$err && (my $schema = $info->{returns})) {
 
 	my $res = PVE::JSONSchema::validate($resp->{data}, $schema);
 	if (!$res->{valid}) {
 
 	    $resp->{message} = "SERVER ERROR: result verification vailed";
 	    $resp->{status} = HTTP_INTERNAL_SERVER_ERROR;
-	    $resp->{data} = { 
-		errors => $res->{errors},
-		data => $resp->{data},
-	    };
+	    $resp->{errors} = $res->{errors};
 
-	    return $resp->{status}
+	    print Dumper($resp);
+	    return $resp->{status};
 	} 
     }
 

Modified: pve-manager/pve2/www/manager/LoginWindow.js
===================================================================
--- pve-manager/pve2/www/manager/LoginWindow.js	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/www/manager/LoginWindow.js	2010-07-01 09:07:12 UTC (rev 4855)
@@ -39,7 +39,7 @@
 	    items: [{
 		xtype: 'form',
 		frame: true,
-		url: '/api2/ticket',
+		url: '/api2/extjs/ticket',
 
 		labelWidth: 70,
 		labelAlign  : 'right',

Modified: pve-manager/pve2/www/manager/PVECache.js
===================================================================
--- pve-manager/pve2/www/manager/PVECache.js	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/www/manager/PVECache.js	2010-07-01 09:07:12 UTC (rev 4855)
@@ -27,7 +27,7 @@
 	    throw "no itype specifued";
 
 	Ext.apply(config, {
-	    root: 'result',
+	    root: 'data',
 
 	    startUpdate: function() {
 		run_load_task(10);

Modified: pve-manager/pve2/www/manager/PVEUtils.js
===================================================================
--- pve-manager/pve2/www/manager/PVEUtils.js	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/www/manager/PVEUtils.js	2010-07-01 09:07:12 UTC (rev 4855)
@@ -1,5 +1,9 @@
 Ext.ns("PVE");
 
+Ext.Ajax.defaultHeaders = {
+    'Accept': 'application/json'
+};
+
 PVE.Utils = function() {
 
     var utils = {

Modified: pve-manager/pve2/www/manager/index.pl
===================================================================
--- pve-manager/pve2/www/manager/index.pl	2010-07-01 06:55:15 UTC (rev 4854)
+++ pve-manager/pve2/www/manager/index.pl	2010-07-01 09:07:12 UTC (rev 4855)
@@ -3,6 +3,7 @@
 use strict;
 use mod_perl2 '1.9922';
 use Encode;
+use CGI;
 
 sub send_output {
     my ($r, $data) = @_;




More information about the pve-devel mailing list