diff --git a/clusterd/clusterd b/clusterd/clusterd index f6c7dc2..7b78e93 100755 --- a/clusterd/clusterd +++ b/clusterd/clusterd @@ -3,12 +3,226 @@ use warnings; use strict; -use Donald::Tools qw(encode sign check_sign decode); -use Donald::FileInfo; use POSIX; use IO::Pipe; use Digest::MD5; +#------------------------------------- +package Donald::Tools; + +our $VERSION = '1.00'; + +use Storable; +use Digest::MD5; + +sub hostname { + our $hostname; + unless (defined $hostname) { + $hostname=lc `/bin/hostname`; + chomp($hostname); + $hostname =~ s/\.molgen\.mpg\.de$//; + } + return $hostname; +} + +sub machine { + our $machine; + chomp($machine=`uname -m`) unless defined $machine; + return $machine; +} + +sub is_alpha { + return machine() eq 'alpha'; +} + +sub uptime { + open U,'<','/proc/uptime' or die "/proc/uptime: $!\n"; + my $data; + sysread(U,$data,1024); + close U; + $data=~ /^(\d+\.?\d*)/ or die "bad data from /proc/uptime: $data\n"; + return $1+0; +} + +sub encode { + return Storable::nfreeze([@_]); +} + +sub sign { + my ($password,$data)=@_; + return Digest::MD5::md5($password.$data).$data; # 16 byte prefix +} + +sub check_sign { # signed-data -> undef or signed-data -> data + my ($password,$data)=@_; + length $data>16 or return undef; + my $rx_digest=substr($data,0,16); + my $signature=Digest::MD5::md5($password.substr($data,16)); + $rx_digest eq $signature or return undef; + return substr($data,16); +} + +sub decode { + my ($data)=@_; + my $msg; + eval { + $msg=Storable::thaw($data); + }; + $@ and return undef; + return @$msg; +} + +sub kill_previous_server { # kill_previous_server('clusterd') + my ($command)=@_; + my $ret=0; + + # quickfix - dont kill our parent which might be the init.d/script with the same name.... + + my $ppid; + for (`ps -o ppid,comm -p $$`) { + $ppid=$1 if /(\d+)/; + } + + for (`ps -Ao pid,comm`) { + my @F=split; + if ($F[1] eq $command && $F[0] ne $$ && $F[0] ne $ppid) { + kill 1=>$F[0]; + warn "stopped $command pid $F[0]\n"; + $ret=1; + } + } + return $ret; +} + +#------------------------------------- +package main; + +*encode=*Donald::Tools::encode{CODE}; +*sign=*Donald::Tools::sign{CODE}; +*check_sign=*Donald::Tools::check_sign{CODE}; +*decode=*Donald::Tools::decode{CODE}; + +#------------------------------------- +package Donald::FileInfo; + +use warnings; +use strict; + +our $VERSION = '1.00'; + +use Class::Struct (map {$_=>'$'} qw(name dev ino type perm nlink uid gid rdev size mtime target)) ; +use Fcntl ':mode'; + +sub fn_escape { + my ($fn)=@_; + $fn=~s/([[:^graph:]\\])/'\x'.sprintf('%02x',ord($1))/ge; + return $fn; +} + +sub fn_unescape { + my ($fn)=@_; + $fn=~s/\\x([0-9a-f]{0,2})/chr(hex($1))/gie; + return $fn; +} + +# +# internal storage: +# +# 0 1 2 3 4 5 6 7 8 9 10 11 +# [ name , dev , ino , type , perm ,nlink , uid , gid , rdev , size , mtime target ] + +# +# index file format: +# +# 0 1 2 3 4 5 6 7 +# F path perm uid gid size mtime hardlink +# D path perm uid gid - mtime - +# L path perm uid gid target - hardlink +# B path perm uid gid rdev - hardlink +# C path perm uid gid rdev - hardlink +# P path perm uid gid - - hardlink +# S path perm uid gid - - hardlink + +sub name_escaped { + my ($self)=shift; + return fn_escape($self->name); +} + +sub fileid { + my ($self)=shift; + return($self->dev.'.'.$self->ino); +} + +sub export_index { + my ($self)=@_; + my $type=$self->type; + return ( + $type, + fn_escape($self->name), + $self->perm, + $self->uid, + $self->gid, + ( + $type eq 'F' ? $self->size : + $type eq 'L' ? fn_escape($self->target) : + $type eq 'B' || $type eq 'C' ? $self->rdev : + '-' + ), + $type eq 'F'||$type eq 'D' ? $self->mtime : '-', + ); +} + +sub import_index { + my ($class,@F)=@_; + my $type=$F[0]; + return bless [ + fn_unescape($F[1]), # name + 0,0, # dev,ino + $type, # type + $F[2], # perm + 0, # nlink + $F[3],$F[4], # uid,gid + ($type eq 'B' || $type eq 'C' ? $F[5] : 0), # rdev + ($type eq 'F' ? $F[5] : 0 ), # size + ($type eq 'F'||$type eq 'D' ? $F[6] : 0 ), # mtime + ($type eq 'L' ? fn_unescape($F[5]) : ''), # target + ], + $class; +} + +sub lstat { + my ($class,$filename)=@_; + my $target; + my @f; + + unless (@f=lstat $filename) { + $!==2 and return undef; # ENOENT + die "$filename: $!\n"; + } + if (-l _) { + defined ($target=readlink($filename)) or die "$filename: $!\n"; + } + my $type = + S_ISREG($f[2]) ? 'F' : + S_ISDIR($f[2]) ? 'D' : + S_ISLNK($f[2]) ? 'L' : + S_ISBLK($f[2]) ? 'B' : + S_ISCHR($f[2]) ? 'C' : + S_ISFIFO($f[2]) ? 'P' : + S_ISSOCK($f[2]) ? 'S' : + die ("$filename: unsupported file type\n"); + return bless [ + $filename, # name + @f[0,1], # dev,ino + $type, # type + S_IMODE($f[2]), # perm + @f[3..7], # nlink,uid,gid,rdev,size + $f[9], # mtime + ($type eq 'L' ? $target : '') # target + ], + $class; +} + #------------------------------------- package My::Select;