[pve-devel] r6129 - in pve-common/trunk/data: . PVE

[svn-commits at proxmox.com]

Author: dietmar
Date: 2011-06-21 10:37:25 +0200 (Tue, 21 Jun 2011)
New Revision: 6129

Modified:
   pve-common/trunk/data/ChangeLog
   pve-common/trunk/data/PVE/RESTHandler.pm
   pve-common/trunk/data/PVE/Tools.pm
Log:


Modified: pve-common/trunk/data/ChangeLog
===================================================================
--- pve-common/trunk/data/ChangeLog	2011-06-21 05:33:51 UTC (rev 6128)
+++ pve-common/trunk/data/ChangeLog	2011-06-21 08:37:25 UTC (rev 6129)
@@ -1,3 +1,9 @@
+2011-06-21  Proxmox Support Team  <support at proxmox.com>
+
+	* PVE/RESTHandler.pm (api_dump): new - used to generate docu
+
+	* PVE/Tools.pm (upid_decode): fix upid parser
+
 2011-05-10  Proxmox Support Team  <support at proxmox.com>
 
 	* PVE/RESTHandler.pm (handle): untaint parameters after validate

Modified: pve-common/trunk/data/PVE/RESTHandler.pm
===================================================================
--- pve-common/trunk/data/PVE/RESTHandler.pm	2011-06-21 05:33:51 UTC (rev 6128)
+++ pve-common/trunk/data/PVE/RESTHandler.pm	2011-06-21 08:37:25 UTC (rev 6129)
@@ -9,6 +9,7 @@
 use PVE::JSONSchema;
 use HTTP::Status qw(:constants :is status_message);
 use Text::Wrap;
+use Storable qw(dclone);
 
 # fixme: use new PVE::Exception
 
@@ -19,6 +20,129 @@
 
 our $AUTOLOAD;  # it's a package global
 
+sub api_clone_schema {
+    my ($schema) = @_;
+
+    my $res = {};
+    my $ref = ref($schema);
+    die "not a HASH reference" if !($ref && $ref eq 'HASH');
+
+    foreach my $k (keys %$schema) {
+	my $d = $schema->{$k};
+	if ($k ne 'properties') {
+	    $res->{$k} = ref($d) ? dclone($d) : $d;
+	    next;
+	}
+	# convert indexed parameters like -net\d+ to -net[n]
+	foreach my $p (keys %$d) {
+	    my $pd = $d->{$p};
+	    if ($p =~ m/^([a-z]+)(\d+)$/) {
+		if ($2 == 0) {
+		    $p = "$1\[n\]";
+		} else {
+		    next;
+		}
+	    }
+	    $res->{$k}->{$p} = ref($pd) ? dclone($pd) : $pd;
+	}
+    }
+
+    return $res;
+}
+
+sub api_dump_full {
+    my ($tree, $index, $class, $prefix) = @_;
+
+    $prefix = '' if !$prefix;
+
+    my $ma = $method_registry->{$class};
+
+    foreach my $info (@$ma) {
+
+	my $path = "$prefix/$info->{path}";
+	$path =~ s/\/+$//;
+
+	if ($info->{subclass}) {
+	    api_dump_full($tree, $index, $info->{subclass}, $path);
+	} else {
+	    next if !$path;
+
+	    # check if method is unique
+	    my $realpath = $path;
+	    $realpath =~ s/\{[^\}]+\}/\{\}/g;
+	    my $fullpath = "$info->{method} $realpath";
+	    die "duplicate path '$realpath'" if $index->{$fullpath};
+	    $index->{$fullpath} = $info;
+
+	    # insert into tree
+	    my $treedir = $tree;
+	    my $res;
+	    my $sp = '';
+	    foreach my $dir (split('/', $path)) {
+		next if !$dir;
+		$sp .= "/$dir";
+		$res = (grep { $_->{text} eq $dir } @$treedir)[0];
+		if ($res) {
+		    $res->{children} = [] if !$res->{children};
+		    $treedir = $res->{children};
+		} else {
+		    $res = {
+			path => $sp,
+			text => $dir,
+			children => [],
+		    };
+		    push @$treedir, $res;
+		    $treedir = $res->{children};
+		}
+	    }
+
+	    if ($res) {
+		my $data = {};
+		foreach my $k (keys %$info) {
+		    next if $k eq 'code' || $k eq "match_name" || $k eq "match_re" ||
+			$k eq "path";
+
+		    my $d = $info->{$k};
+		    
+		    if ($k eq 'parameters') {
+			$data->{$k} = api_clone_schema($d);
+		    } else {
+
+			$data->{$k} = ref($d) ? dclone($d) : $d;
+		    }
+		} 
+		$res->{info}->{$info->{method}} = $data;
+	    };
+	}
+    }
+};
+
+sub api_dump_cleanup_tree {
+    my ($tree) = @_;
+
+    foreach my $rec (@$tree) {
+	delete $rec->{children} if $rec->{children} && !scalar(@{$rec->{children}});
+	if ($rec->{children}) {
+	    $rec->{leaf} = 0;
+	    api_dump_cleanup_tree($rec->{children});
+	} else {
+	    $rec->{leaf} = 1;
+	}
+    }
+
+}
+
+sub api_dump {
+    my ($class, $prefix) = @_;
+
+    my $tree = [];
+
+    my $index = {};
+    api_dump_full($tree, $index, $class);
+    api_dump_cleanup_tree($tree);
+    return $tree;
+};
+
 sub validate_method_schemas {
 
     foreach my $class (keys %$method_registry) {

Modified: pve-common/trunk/data/PVE/Tools.pm
===================================================================
--- pve-common/trunk/data/PVE/Tools.pm	2011-06-21 05:33:51 UTC (rev 6128)
+++ pve-common/trunk/data/PVE/Tools.pm	2011-06-21 08:37:25 UTC (rev 6129)
@@ -537,7 +537,7 @@
     my $filename;
 
     # "UPID:$node:$pid:$pstart:$startime:$dtype:$id:$user"
-    if ($upid =~ m/^UPID:(\w+):([0-9A-Fa-f]{8}):([0-9A-Fa-f]{8}):([0-9A-Fa-f]{8}):([^:\s]+):([^:\s]*):([^:\s]+):$/) {
+    if ($upid =~ m/^UPID:([A-Za-z][[:alnum:]\-]*[[:alnum:]]+):([0-9A-Fa-f]{8}):([0-9A-Fa-f]{8}):([0-9A-Fa-f]{8}):([^:\s]+):([^:\s]*):([^:\s]+):$/) {
 	$res->{node} = $1;
 	$res->{pid} = hex($2);
 	$res->{pstart} = hex($3);