r23586 - /scripts/KGB/server/KGB

[dmn at users.alioth.debian.org]

Author: dmn
Date: Sat Jul 26 15:28:34 2008
New Revision: 23586

URL: http://svn.debian.org/wsvn/?sc=1&rev=23586
Log:
protocol version 1 -- sha1 authentication

6-argument call are considered protocol 0

common parts of protocol 0 and 1 moved in do_commit_01

Modified:
    scripts/KGB/server/KGB

Modified: scripts/KGB/server/KGB
URL: http://svn.debian.org/wsvn/scripts/KGB/server/KGB?rev=23586&op=diff
==============================================================================
--- scripts/KGB/server/KGB (original)
+++ scripts/KGB/server/KGB Sat Jul 26 15:28:34 2008
@@ -29,6 +29,7 @@
 use Getopt::Long;
 use List::Util qw(max);
 use YAML ();
+use Digest::SHA1 qw(sha1_hex);
 
 my $conf = YAML::LoadFile("kgb.conf") or die "Error loading config";
 
@@ -152,35 +153,10 @@
     delete $heap->{$_} foreach(keys %$heap);
     undef;
 }
-sub do_commit {
-    my $kernel = $_[KERNEL];
-    my $response = $_[ARG0];
-    my $params = $response->soapbody;
-    warn("commit: " . YAML::Dump($params));
-    unless(ref $params and ref $params eq "HASH"
-            and $params->{Array} and ref $params->{Array}
-            and ref $params->{Array} eq "ARRAY"
-            and scalar @{$params->{Array}} == 6) {
-        $kernel->post(SOAPServer => 'FAULT', $response, 'Client.Arguments',
-            'commit(string repo_id, string password, int rev, ' .
-            'string[] paths, string log, string author)');
-        warn("Invalid call\n");
-        return;
-    }
-    my($repo_id, $passwd, $rev, $paths, $log, $author) = @{$params->{Array}};
-    unless($conf->{repositories}{$repo_id}) {
-        $kernel->post(SOAPServer => 'FAULT', $response, 'Client.Arguments',
-            "Repository $repo_id is unknown");
-        warn("Unknown repository\n");
-        return
-    }
-    if($conf->{repositories}{$repo_id}{password} and
-        $conf->{repositories}{$repo_id}{password} ne $passwd) {
-        $kernel->post(SOAPServer => 'FAULT', $response, 'Client.Arguments',
-            "Invalid password for repository $repo_id");
-        warn("Invalid password\n");
-        return
-    }
+sub do_commit_01 {
+    my $kernel = $_[KERNEL];
+    my $response = $_[ARG0];
+    my($repo_id, $rev, $paths, $log, $author) = @_;
     my @log = split(/\n+/, $log);
     my @string = ("\002$repo_id\017: \00303$author\017 * r\002$rev\017 " .
         "(files: \00310@$paths\017) $log[0]");
@@ -211,6 +187,71 @@
     $response->content( "OK" );
     $kernel->post( SOAPServer => 'DONE', $response );
 }
+sub do_commit_0 {
+    my $kernel = $_[KERNEL];
+    my $response = $_[ARG0];
+    my($repo_id, $passwd, $rev, $paths, $log, $author) = @_;
+    unless($conf->{repositories}{$repo_id}) {
+        $kernel->post(SOAPServer => 'FAULT', $response, 'Client.Arguments',
+            "Repository $repo_id is unknown");
+        warn("Unknown repository\n");
+        return
+    }
+    if($conf->{repositories}{$repo_id}{password} and
+        $conf->{repositories}{$repo_id}{password} ne $passwd) {
+        $kernel->post(SOAPServer => 'FAULT', $response, 'Client.Arguments',
+            "Invalid password for repository $repo_id");
+        warn("Invalid password\n");
+        return
+    }
+    do_commit_01($repo_id, $rev, $paths, $log, $author) = @_;
+}
+sub do_commit_1 {
+    my $kernel = $_[KERNEL];
+    my $response = $_[ARG0];
+    my($repo_id, $checksum, $rev, $paths, $log, $author) = @_;
+    unless($conf->{repositories}{$repo_id}) {
+        $kernel->post(SOAPServer => 'FAULT', $response, 'Client.Arguments',
+            "Repository $repo_id is unknown");
+        warn("Unknown repository\n");
+        return
+    }
+    if($conf->{repositories}{$repo_id}{password}
+	    and sha1_hex(repo_id, $rev, @$paths, $log, $author) ne $checksum) {
+        $kernel->post(SOAPServer => 'FAULT', $response, 'Client.Arguments',
+            "Authentication failed for repository $repo_id");
+        warn("Authentication failed\n");
+        return
+    }
+    do_commit_01($repo_id, $rev, $paths, $log, $author) = @_;
+}
+sub do_commit {
+    my $kernel = $_[KERNEL];
+    my $response = $_[ARG0];
+    my $params = $response->soapbody;
+    warn("commit: " . YAML::Dump($params));
+    unless(ref $params and ref $params eq "HASH"
+            and $params->{Array} and ref $params->{Array}
+            and ref $params->{Array} eq "ARRAY") {
+        $kernel->post(SOAPServer => 'FAULT', $response, 'Client.Arguments',
+            'commit(params ...)');
+        warn("Invalid call\n");
+        return;
+    }
+    if( @{$params->{Array}} == 6 ) {
+    	# protocol 0
+	return do_commit_0(@{$params->{Array}});
+    } 
+    my $proto_ver = shift @{$params->{Array}};
+    if($proto_ver == 1) {
+	return do_commit_1(@{$params->{Array}})
+    } else {
+        $kernel->post(SOAPServer => 'FAULT', $response, 'Client.Arguments',
+            "Invalid protocol version ($protocol_ver)");
+        warn("Invalid protocol version ($protocol_ver)\n");
+        return;
+    }
+}
 sub irc_default {
     my ($event, $args) = @_[ ARG0 .. $#_ ];
     my $out = "$event ";