generate BerkeleyDB md5 hash, remove dependencies

diff --git a/bin/debian-install.sh b/bin/debian-install.sh
index da88f18..fae3dcc 100755 (executable)
--- a/bin/debian-install.sh
+++ b/bin/debian-install.sh
@@ -1,5 +1,5 @@
 #!/bin/sh -x
 
 sudo apt-get install libautodie-perl libdata-dump-perl libfile-slurp-perl libtime-hires-perl \
-libjson-xs-perl libmodule-refresh-perl libnss-extrausers
+libjson-xs-perl libmodule-refresh-perl libnss-extrausers libberkeleydb-perl
 

diff --git a/lib/CloudStore/Store.pm b/lib/CloudStore/Store.pm
index 401c95e..c879681 100644 (file)
--- a/lib/CloudStore/Store.pm
+++ b/lib/CloudStore/Store.pm
@@ -6,173 +6,55 @@ use autodie;
 use JSON::XS;
 use File::Path qw(make_path);
 use File::Slurp qw();
-use Cache::Memcached;
 use Digest::MD5 qw(md5_base64);
 use Data::Dump qw(dump);
-use LWP::Simple;
 use Carp qw(confess);
+use BerkeleyDB;
 
 use WarnColor;
 
-my $buckets = {
-       users => 5800,
-       files => 5801,
-       session => 5802,
-};
-
 sub new {
        my ($class) = @_;
 
        my $self = {};
        bless $self, $class;
 
-       foreach my $bucket ( keys %$buckets ) {
-               my $port = $buckets->{$bucket};
-               my $server = new Cache::Memcached {
-                       'servers' => [ "127.0.0.1:$port" ],
-                       'debug' => defined $ENV{DEBUG} && $ENV{DEBUG} > 3,
-               #       'compress_threshold' => 10_000,
-               };
-               #$server->set_servers($array_ref);
-               #$server->set_compress_threshold(10_000);
-               $server->enable_compress(0);
-               $self->{$bucket} = $server;
-
-       }
+       my %md5;
+       $self->{db} = tie %md5, 'BerkeleyDB::Hash', -Filename => '/tmp/md5.db', -Flags => DB_CREATE;
+       $self->{md5} = \%md5;
 
        warn "# new ",dump $self if $ENV{DEBUG};
 
        return $self;
 }
 
-sub json_set {
-       my ($self,$bucket,$key,$data) = @_;
-       confess "data not ref ",dump($data) unless ref $data;
-       my $json = encode_json $data;
-       $self->{$bucket}->set( $key => $json );
-       warn "## json_set $bucket $key $json\n";
-       return $json;
-}
-
-sub json_get {
-       my ($self,$bucket,$key,$data) = @_;
-       if ( my $json = $self->{$bucket}->get($key) ) {
-               warn "## json_get $bucket $key $json\n";
-               return decode_json $json;
-       }
-}
-
 sub user_set {
-       my ($self,$data) = @_;
-       $self->json_set( 'users', $data->{login}, $data );
+       my ( $self,$data ) = @_;
 }
 
 sub user_get {
-       my ($self,$login) = @_;
-       $login = $login->{login} if ref $login;
-       my $user = $self->json_get( 'users', $login );
-       $user->{usage} = $self->usage( $login );
-       $user->{status} = $self->status( $login );
-       warn "## user ",dump($user) if $ENV{DEBUG};
-       return $user;
-}
-
-sub status {
-       my ($self,$login,$message) = @_;
-       $login = $login->{login} if ref $login;
-       if ( $message ) {
-               $self->{session}->set( "$login:status" => $message );
-               return $message;
-       } else {
-               $self->{session}->get( "$login:status" );
-       }
-}
-
-sub usage_decr {
-       my ($self,$data) = @_;
-       $self->{session}->decr( $data->{login} . ':usage' => $data->{size} );
-}
-
-sub usage_incr {
-       my ($self,$data) = @_;
-       $self->{session}->incr( $data->{login} . ':usage' => $data->{size} );
-}
-
-sub usage {
-       my ($self,$login) = @_;
-       $login = $login->{login} if ref $login;
-       $self->{session}->get( $login . ':usage' );
-}
-
-sub couchdb {
-       my $self = shift @_;
-       my $fmt  = shift @_;
-       my $url = sprintf $fmt, @_;
-
-       warn "# couchdb $url\n";
-       if ( my $json = get $url ) {
-               warn "## $url $json\n";
-               my $r = decode_json $json;
-               return $r;
-       }
-}
-
-sub usage_init {
-       my ($self,$login) = @_;
-       $login = $login->{login} if ref $login;
-
-       my $usage = 0;
-
-       if ( my $r = $self->couchdb(
-               'http://localhost:5984/files/_design/files/_view/login_usage?group=true&connection_timeout=60000&limit=1&skip=0&start_key="%s"&end_key="%s"&stale=update_after'
-               , $login
-               , $login
-       )) {
-
-               $usage = $r->{rows}->[0]->{value};
-               $usage = 0 unless defined $usage;
-       }
-
-       $self->{session}->set( $login . ':usage' => $usage );
-}
-
-sub _file_key {
-       my $data = shift;
-       #md5_base64( $data->{login} . '/' . $data->{file} );
-       $data->{login} . ':' . $data->{file};
-}
-
-sub file_set {
-       my ($self,$data) = @_;
-       $self->json_set( 'files', _file_key($data), $data );
-}
-
-sub file_get {
-       my ($self,$data) = @_;
-       $self->json_get( 'files', _file_key($data) );
+       my ( $self,$data ) = @_;
 }
 
 sub modify_file {
        my ( $self,$data ) = @_;
 
-       if ( my $old = $self->file_get( $data ) ) {
-               $self->usage_decr( $data );
-       }
+#      if ( my $old = $self->file_get( $data ) ) {
+#              $self->usage_decr( $data );
+#      }
 
        $self->new_file($data);
 }
 
 sub new_file {
        my ( $self,$data ) = @_;
-       $self->file_set($data);
-       $self->usage_incr($data);
+#      $self->file_set($data);
+#      $self->usage_incr($data);
 }
 
 sub remove_file {
        my ( $self, $data ) = @_;
-       $self->usage_decr( $data );
-       my $k = _file_key $data;
-       $self->{files}->delete( $k );
+#      $self->usage_decr( $data );
 }
 
 sub make_dir {
@@ -221,12 +103,14 @@ sub new_link {
 
                                my ($l,$f) = ($1,$2) if $s =~ m{users/([^/]+)/blob/(.+)};
 
-                               my $origin = $self->file_get({
-                                       login => $l,
-                                       file  => $f,
-                               });
-                               $self->new_file($origin);
-                               warn "INFO: sent file ",dump($origin);
+#                              my $origin = $self->file_get({
+#                                      login => $l,
+#                                      file  => $f,
+#                              });
+#                              $self->new_file($origin);
+                               warn "INFO: sent file ",dump($l,$f);
+                               my $md5 = $self->{md5}->{$s} || die "no md5 for $s";
+                               $self->{md5}->{$d} = $md5;
                        }
 
 
@@ -262,7 +146,7 @@ sub transfer {
 }
 
 sub md5pool {
-       my ( $path, $md5 ) = @_;
+       my ( $self, $path, $md5 ) = @_;
 
        my $pool = 'md5'; # FIXME sharding?
        mkdir $pool unless -e $pool;
@@ -273,9 +157,13 @@ sub md5pool {
                rename $path, $dedup;
                link "$pool/$md5", $path;
                unlink $dedup;
+               # FIXME fix perms?
        } else {
                link $path, "$pool/$md5";
        }
+
+       $self->{md5}->{$path} = $md5;
+       warn "++ $md5 $path\n";
 }
 
 my $empty_md5 = " " x 32;
@@ -311,16 +199,16 @@ sub dedup {
                                $self->new_file($fake);
                                warn "import from $path ",dump($fake);
                        } else {
-                               md5pool $new => $md5;
+                               $self->md5pool( $new => $md5 );
                        }
                }
                print "INFO imported $imported files from ",dump($data);
        }
 
        if ( $data->{md5} ne $empty_md5 ) {
-               md5pool $path => $data->{md5};
+               $self->md5pool( $path => $data->{md5} );
        } else {
-               
+               warn "empty md5", dump $data;
        }
 }
 

diff --git a/rsync-piper.pl b/rsync-piper.pl
index ed6d11b..983fcbe 100755 (executable)
--- a/rsync-piper.pl
+++ b/rsync-piper.pl
@@ -141,6 +141,7 @@ sub rsync_running_pid {
 if ( my $pid = rsync_running_pid ) {
        if ( kill 0, $pid ) {
                warn "found rsync pid $pid\n";
+               kill 1, $pid && warn "reload config";
 =for kill-rsync
                kill 2, $pid;
                while ( -e $pid_file ) {

diff --git a/rsync-xfer-trigger.pl b/rsync-xfer-trigger.pl
index 9f9f370..92101ec 100755 (executable)
--- a/rsync-xfer-trigger.pl
+++ b/rsync-xfer-trigger.pl
@@ -11,6 +11,8 @@ my $store = CloudStore::Store->new;
 
 my $login = $ENV{RSYNC_MODULE_NAME} || die "no RSYNC_MODULE_NAME";
 
+exit 0; # FIXME
+
 my $user  = $store->user_get($login);
 
 my $ok = $user->{usage} <= $user->{quota};

diff --git a/store-fsck.pl b/store-fsck.pl
deleted file mode 100755 (executable)
index ebbc981..0000000
--- a/store-fsck.pl
+++ /dev/null
@@ -1,46 +0,0 @@
-#!/usr/bin/perl
-use warnings;
-use strict;
-
-use Data::Dump qw(dump);
-
-use lib 'lib';
-use CloudStore::Store;
-
-my $login = $ARGV[0] || die "usage: $0 login\n";
-
-my $store = CloudStore::Store->new;
-
-my $offset = 0;
-my $limit  = $ENV{LIMIT} || 10000;
-
-while(1) {
-       my $r = $store->couchdb(
-               'http://10.60.0.244:5984/files/_design/files/_view/login_usage?reduce=false&connection_timeout=60000&limit=%d&skip=%d&start_key="%s"&end_key="%s"', $limit, $offset, $login, $login
-       ) || die;
-
-       last if $#{ $r->{rows} } < 1;
-
-       foreach my $row ( @{ $r->{rows} } ) {
-               my ( $login, $file ) = split(/:/,$row->{id},2);
-               my $path = "users/$login/blob/$file";
-               if ( -e $path ) {
-                       warn "+ $path\n";
-               } else {
-                       $store->remove_file({
-                               login => $login,
-                               file  => $file,
-                               size  => $row->{value},
-                       });
-                       warn "- $path\n";
-               }
-       }
-
-       $offset += $limit;
-
-}
-
-$store->usage_init( $login );
-
-print dump( $store->user_get( $login ) );
-

diff --git a/test.sh b/test.sh
index 5667336..be55b54 100755 (executable)
--- a/test.sh
+++ b/test.sh
@@ -19,7 +19,6 @@ pull() {
 
 ./create-user.sh test secret
 ./create-user.sh test secret localhost
-./store-fsck.pl test
 
 ./remove-user.sh test2
 ./create-user.sh test2 secret