Index: trunk/Nebulous/Build.PL =================================================================== --- trunk/Nebulous/Build.PL (revision 16566) +++ trunk/Nebulous/Build.PL (revision 17073) @@ -75,45 +75,43 @@ $class->new( module_name => 'Nebulous', - dist_version_from => 'lib/Nebulous/Server.pm', + dist_version_from => 'lib/Nebulous/Client.pm', author => 'Joshua Hoblitt ', license => 'gpl', create_makefile_pl => 'passthrough', requires => { + 'File::Copy' => 0, + 'Time::HiRes' => 0, 'Class::Accessor::Fast' => 0, - 'Config::YAML' => '1.42', - 'DBD::mysql' => '3.0007', - 'DBI' => '1.53', - 'Digest::SHA1' => 0, - 'File::ExtAttr' => '1.03', - 'File::Path' => '1.08', 'File::Spec' => 0, 'File::Spec::Functions' => 0, 'Log::Log4perl' => '0.48', - 'Net::Server::Daemonize'=> '0.05', 'Params::Validate' => '0.73', 'SOAP::Lite' => '0.69', - 'Sys::Statistics::Linux::DiskUsage' => '0.02', 'URI' => '1.30', - }, - build_requires => { - 'Apache2::SOAP' => 0, - 'Apache::DBI' => '1.05', - 'Apache::Test' => '1.27', # bundles Apache::TestMB - 'Apache::TestMB' => 0, - 'File::Temp' => 0, - 'Test::More' => '0.49', - 'Test::URI' => '1.06', + 'Getopt::Long' => 0, + 'Pod::Usage' => 0, +# below are for ./bin only any need to go away + 'DBD::mysql' => '3.0007', + 'DBI' => '1.53', + 'Nebulous::Server::SQL' => 0, }, recommends => { - 'Test::Distribution' => '1.22', + 'Nebulous::Server::Apache' => 0, + 'Nebulous::Server' => 0, + 'Nebulous::Server::SOAP' => 0, + 'Test::Nebulous' => 0, + 'Apache2::SOAP' => 0, + 'Apache::DBI' => '1.05', + 'Apache::Test' => '1.27', # bundles Apache::TestMB + 'Apache::TestMB' => 0, + 'Test::More' => '0.49', + 'Test::URI' => '1.06', + 'Test::Distribution' => '1.22', }, script_files => [qw( - bin/neb-addvol bin/neb-cat bin/neb-cp bin/neb-cull bin/neb-df - bin/neb-fsck - bin/neb-initdb bin/neb-locate bin/neb-ls @@ -123,5 +121,4 @@ bin/neb-stat bin/neb-touch - bin/nebdiskd )], )->create_build_script; Index: trunk/Nebulous/Changes =================================================================== --- trunk/Nebulous/Changes (revision 16566) +++ trunk/Nebulous/Changes (revision 17073) @@ -2,4 +2,5 @@ 0.07 + - server/client split into Nebulous::Server and Nebulous::Client packages - add support for storing instances in multi-tier 'hashed' directories - pickup test DB settings from the env. Index: trunk/Nebulous/MANIFEST =================================================================== --- trunk/Nebulous/MANIFEST (revision 16566) +++ trunk/Nebulous/MANIFEST (revision 17073) @@ -8,11 +8,8 @@ Todo autogen.sh -bin/neb-addvol bin/neb-cat bin/neb-cp bin/neb-cull bin/neb-df -bin/neb-fsck -bin/neb-initdb bin/neb-locate bin/neb-ls @@ -22,5 +19,4 @@ bin/neb-stat bin/neb-touch -bin/nebdiskd docs/c_api.h docs/database_setup.txt @@ -37,12 +33,4 @@ lib/Nebulous/Client/Log.pm lib/Nebulous/Client/QuickStart.pod -lib/Nebulous/Keys.pod -lib/Nebulous/Server.pm -lib/Nebulous/Server.pod -lib/Nebulous/Server/Apache.pm -lib/Nebulous/Server/Config.pm -lib/Nebulous/Server/Log.pm -lib/Nebulous/Server/SOAP.pm -lib/Nebulous/Server/SQL.pm lib/Nebulous/Util.pm nebclient/Doxyfile.in @@ -98,17 +86,4 @@ t/00_distribution.t t/01_load.t -t/02_server_setup.t -t/03_server_create_object.t -t/04_server_replicate_object.t -t/05_server_lock_object.t -t/06_server_unlock_object.t -t/07_server_find_instances.t -t/08_server_delete_instance.t -t/09_server_stat_object.t -t/10_server_is_valid_volume_name.t -t/11_server_is_valid_object_key.t -t/12_server_find_objects.t -t/13_server_rename_object.t -t/14_server_xattr.t t/50_client_new.t t/51_client_create.t @@ -130,5 +105,4 @@ t/90_nebclient.t t/TEST.PL -t/Test/Nebulous.pm t/conf/extra.conf.in t/conf/startup.pl.in Index: trunk/Nebulous/bin/neb-addvol =================================================================== --- trunk/Nebulous/bin/neb-addvol (revision 16566) +++ (revision ) @@ -1,177 +1,0 @@ -#!/usr/bin/env perl - -# Copyright (C) 2005-2008 Joshua Hoblitt -# -# $Id: neb-addvol,v 1.8 2008-02-05 23:14:22 eugene Exp $ - -use strict; -use warnings FATAL => qw( all ); - -use vars qw( $VERSION ); -$VERSION = '0.01'; - -use DBI; -use Nebulous::Server::SQL; -use URI::file; -use URI; - -use Getopt::Long qw( GetOptions :config auto_help auto_version ); -use Pod::Usage qw( pod2usage ); - -my ($db, $dbuser, $dbpass, $volume, $uri); - -$db = $ENV{'NEB_DB'} unless $db; -$dbuser = $ENV{'NEB_USER'} unless $dbuser; -$dbpass = $ENV{'NEB_PASS'} unless $dbpass; - -GetOptions( - 'db=s' => \$db, - 'user=s' => \$dbuser, - 'pass=s' => \$dbpass, - 'volume=s' => \$volume, - 'uri|u=s' => \$uri, -) || pod2usage( 2 ); - -pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; -pod2usage( -msg => "Required options: --db --user --pass", -exitval => 2 ) - unless $db && $dbuser && $dbpass && $volume && $uri; - -my $dbh = DBI->connect( - "DBI:mysql:database=$db:host=localhost", - $dbuser, - $dbpass, - { - RaiseError => 1, - PrintError => 0, - AutoCommit => 1, - }, -); - -my $sql = Nebulous::Server::SQL->new(); - -print "Checking URI..."; - -my $path = URI->new($uri)->path; -unless (-d $path) { - die "path: $path dirived from URI: $uri does not exist"; -} - -print " OK\n"; - -print "Adding volume..."; - -my $query = $dbh->prepare( $sql->new_volume ); -$query->execute( $volume, $path ); - -print " OK\n"; - -__END__ - -=pod - -=head1 NAME - -neb-addvol - add a storage volume to a Nebulous server - -=head1 SYNOPSIS - - neb-addvol --volume --uri - [--db ] [--user ] [--pass ] - -=head1 DESCRIPTION - -This program initialize a database for use by L by creating -the appropriate set of tables. Any pre-existing tables with conflicting names -are first removed. - -=head1 OPTIONS - -=over 4 - -=item * --volume - -Symbolic name of volume being added. - -=item * --uri|-u - -URI to the volume being added. - -=item * --db|-d - -Name of database (C) to create tables in. - -Optional if the appropriate environment variable is set. - -=item * --user|-u - -Username to authenticate with. - -Optional if the appropriate environment variable is set. - -=item * --pass|-p - -Password to authenticate with. - -Optional if the appropriate environment variable is set. - -=back - -=head1 ENVIRONMENT - -These environment variables may be used in place of the specified command line -options. All command line option will override the corresponding environment -value. - -=over 4 - -=item * C - -Equivalent to --db|-d - -=item * C - -Equivalent to --user|-u - -=item * C - -Equivalent to --pass|-p - -=back - -=head1 CREDITS - -Just me, myself, and I. - -=head1 SUPPORT - -Please contact the author directly via e-mail. - -=head1 AUTHOR - -Joshua Hoblitt - -=head1 COPYRIGHT - -Copyright (C) 2005-2008 Joshua Hoblitt. All rights reserved. - -This program is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free Software -Foundation; either version 2 of the License, or (at your option) any later -version. - -This program is distributed in the hope that it will be useful, but WITHOUT ANY -WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A -PARTICULAR PURPOSE. See the GNU General Public License for more details. - -You should have received a copy of the GNU General Public License along with -this program; if not, write to the Free Software Foundation, Inc., 59 Temple -Place - Suite 330, Boston, MA 02111-1307, USA. - -The full text of the license can be found in the L Pod as supplied -with Perl 5.8.1 and later. - -=head1 SEE ALSO - -L, L, L, L - -=cut Index: trunk/Nebulous/bin/neb-fsck =================================================================== --- trunk/Nebulous/bin/neb-fsck (revision 16566) +++ (revision ) @@ -1,205 +1,0 @@ -#!/usr/bin/env perl - -# Copyright (C) 2005-2008 Joshua Hoblitt -# -# $Id: neb-fsck,v 1.1 2008-01-30 00:19:34 jhoblitt Exp $ - -use strict; -use warnings FATAL => qw( all ); - -use vars qw( $VERSION ); -$VERSION = '0.01'; - -use DBI; -use Nebulous::Server::SQL; -use Nebulous::Client; -use URI; - -use Getopt::Long qw( GetOptions :config auto_help auto_version ); -use Pod::Usage qw( pod2usage ); - -my ($db, $dbuser, $dbpass, $server); - -$db = $ENV{'NEB_DB'} unless $db; -$dbuser = $ENV{'NEB_USER'} unless $dbuser; -$dbpass = $ENV{'NEB_PASS'} unless $dbpass; -$server = $ENV{'NEB_SERVER'} unless $server; - -GetOptions( - 'db=s' => \$db, - 'user=s' => \$dbuser, - 'pass=s' => \$dbpass, - 'server|s=s' => \$server, -) || pod2usage( 2 ); - -pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; -pod2usage( -msg => "Required options: --server", -exitval => 2 ) - unless $server; -pod2usage( -msg => "Required options: --db --user --pass", -exitval => 2 ) - unless $db && $dbuser && $dbpass; - -my $neb = Nebulous::Client->new( - proxy => "$server", -); - -die "can't connected to Nebulous Server: $server" - unless defined $neb; - -my $dbh = DBI->connect( - "DBI:mysql:database=$db:host=localhost", - $dbuser, - $dbpass, - { - RaiseError => 1, - PrintError => 0, - AutoCommit => 1, - }, -); - -my $sql = Nebulous::Server::SQL->new(); - -# so_id, ext_id, instances, available_instances, need_recovery, recoverable -my $query = $dbh->prepare( $sql->find_objects_with_unavailable_instances ); -$query->execute; - -my @rows; -while (my $row = $query->fetchrow_hashref) { - push @rows, $row; -} -$query->finish; - -foreach my $obj (@rows) { - my $so_id = $obj->{so_id}; - my $key = $obj->{ext_id}; - my $has = $obj->{instances}; - my $available = $obj->{instances_available}; - my $need = $obj->{need_recovery}; - my $recoverable = $obj->{recoverable}; - - # objects with only a single instance that are offline are unrecoverable so - # we don't need to handle that special case - next unless $need; - unless ($recoverable) { - warn "so_id: $so_id key: \'$key\' ", - "can not be recovered - no available instances\n"; - next; - } - - $available ||= 0; - next unless $available < 2; - - warn "so_id: $so_id key: \'$key\' ", - " has only 1 instance avaiable -- replicating"; - - $neb->replicate($obj->{ext_id}) - or warn "so_id: $so_id key: \'$key\' failed to replicate"; -} - -__END__ - -=pod - -=head1 NAME - -neb-fsck - check and repair Nebulous volumes - -=head1 SYNOPSIS - - neb-fsck [--db ] [--user ] [--pass ] - [--server ] - -=head1 DESCRIPTION - -=head1 OPTIONS - -=over 4 - -=item * --server|-s - -URL of the Nebulous server to connect to. - -Optional if the appropriate environment variable is set. - -=item * --db|-d - -Name of database (C) to create tables in. - -Optional if the appropriate environment variable is set. - -=item * --user|-u - -Username to authenticate with. - -Optional if the appropriate environment variable is set. - -=item * --pass|-p - -Password to authenticate with. - -Optional if the appropriate environment variable is set. - -=back - -=head1 ENVIRONMENT - -These environment variables may be used in place of the specified command line -options. All command line option will override the corresponding environment -value. - -=over 4 - -=item * C - -Equivalent to --server|-s - -=item * C - -Equivalent to --db|-d - -=item * C - -Equivalent to --user|-u - -=item * C - -Equivalent to --pass|-p - -=back - -=head1 CREDITS - -Just me, myself, and I. - -=head1 SUPPORT - -Please contact the author directly via e-mail. - -=head1 AUTHOR - -Joshua Hoblitt - -=head1 COPYRIGHT - -Copyright (C) 2005-2008 Joshua Hoblitt. All rights reserved. - -This program is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free Software -Foundation; either version 2 of the License, or (at your option) any later -version. - -This program is distributed in the hope that it will be useful, but WITHOUT ANY -WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A -PARTICULAR PURPOSE. See the GNU General Public License for more details. - -You should have received a copy of the GNU General Public License along with -this program; if not, write to the Free Software Foundation, Inc., 59 Temple -Place - Suite 330, Boston, MA 02111-1307, USA. - -The full text of the license can be found in the L Pod as supplied -with Perl 5.8.1 and later. - -=head1 SEE ALSO - -L, L, L, L - -=cut Index: trunk/Nebulous/bin/neb-initdb =================================================================== --- trunk/Nebulous/bin/neb-initdb (revision 16566) +++ (revision ) @@ -1,162 +1,0 @@ -#!/usr/bin/env perl - -# Copyright (C) 2005-2007 Joshua Hoblitt -# -# $Id: neb-initdb,v 1.7 2007-04-28 01:19:59 jhoblitt Exp $ - -use strict; -use warnings FATAL => qw( all ); - -use vars qw( $VERSION ); -$VERSION = '0.02'; - -use DBI; -use Nebulous::Server::SQL; - -use Getopt::Long qw( GetOptions :config auto_help auto_version ); -use Pod::Usage qw( pod2usage ); - -my ($db, $dbuser, $dbpass); - -$db = $ENV{'NEB_DB'} unless $db; -$dbuser = $ENV{'NEB_USER'} unless $dbuser; -$dbpass = $ENV{'NEB_PASS'} unless $dbpass; - -GetOptions( - 'db=s' => \$db, - 'user=s' => \$dbuser, - 'pass=s' => \$dbpass, -) || pod2usage( 2 ); - -pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; -pod2usage( -msg => "Required options: --db --user --pass", -exitval => 2 ) - unless $db && $dbuser && $dbpass; - -my $dbh = DBI->connect( - "DBI:mysql:database=$db:host=localhost", - $dbuser, - $dbpass, - { - RaiseError => 1, - PrintError => 0, - AutoCommit => 1, - }, -); - -my $sql = Nebulous::Server::SQL->new(); - -print "Dropping any existing tables..."; - -foreach my $statement (@{ $sql->get_db_clear }) { - $dbh->do( $statement ); -} - -print " OK\nCreating new tables..."; - -foreach my $statement (@{ $sql->get_db_schema }) { - $dbh->do( $statement ); -} - -print " OK\n"; - -__END__ - -=pod - -=head1 NAME - -neb-initdb - initialize a Nebulous server database - -=head1 SYNOPSIS - - neb-initdb [--db ] [--user ] [--pass ] - -=head1 DESCRIPTION - -This program initialize a database for use by L by creating -the appropriate set of tables. Any pre-existing tables with conflicting names -are first removed. - -=head1 OPTIONS - -=over 4 - -=item * --db|-d - -Name of database (C) to create tables in. - -Optional if the appropriate environment variable is set. - -=item * --user|-u - -Username to authenticate with. - -Optional if the appropriate environment variable is set. - -=item * --pass|-p - -Password to authenticate with. - -Optional if the appropriate environment variable is set. - -=back - -=head1 ENVIRONMENT - -These environment variables may be used in place of the specified command line -options. All command line option will override the corresponding environment -value. - -=over 4 - -=item * C - -Equivalent to --db|-d - -=item * C - -Equivalent to --user|-u - -=item * C - -Equivalent to --pass|-p - -=back - -=head1 CREDITS - -Just me, myself, and I. - -=head1 SUPPORT - -Please contact the author directly via e-mail. - -=head1 AUTHOR - -Joshua Hoblitt - -=head1 COPYRIGHT - -Copyright (C) 2005-2007 Joshua Hoblitt. All rights reserved. - -This program is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free Software -Foundation; either version 2 of the License, or (at your option) any later -version. - -This program is distributed in the hope that it will be useful, but WITHOUT ANY -WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A -PARTICULAR PURPOSE. See the GNU General Public License for more details. - -You should have received a copy of the GNU General Public License along with -this program; if not, write to the Free Software Foundation, Inc., 59 Temple -Place - Suite 330, Boston, MA 02111-1307, USA. - -The full text of the license can be found in the L Pod as supplied -with Perl 5.8.1 and later. - -=head1 SEE ALSO - -L, L, L, L - -=cut Index: trunk/Nebulous/bin/nebdiskd =================================================================== --- trunk/Nebulous/bin/nebdiskd (revision 16566) +++ (revision ) @@ -1,412 +1,0 @@ -#!/usr/bin/env perl - -# Copyright (C) 2007 Joshua Hoblitt -# -# $Id: nebdiskd,v 1.4 2007-05-04 23:36:46 jhoblitt Exp $ - -use strict; -use warnings FATAL => qw( all ); - -use vars qw( $VERSION ); -$VERSION = '0.02'; - -use Config::YAML; -use DBI; -use File::Spec; -use Nebulous::Server::SQL; -use Net::Server::Daemonize qw( daemonize unlink_pid_file ); -use Sys::Statistics::Linux::DiskUsage; - -use Getopt::Long qw( GetOptions :config auto_help auto_version ); -use Pod::Usage qw( pod2usage ); - -my ($debug, $db, $dbuser, $dbpass, $pidfile, $stop, $restart, $verbose); -GetOptions( - 'debug' => \$debug, - 'db|d=s' => \$db, - 'user|u=s' => \$dbuser, - 'pass|p=s' => \$dbpass, - 'pidfile=s' => \$pidfile, - 'stop|s' => \$stop, - 'restart|r' => \$restart, - 'verbose|v' => \$verbose, -) || pod2usage( 2 ); - -my $rcfile = "$ENV{HOME}/.nebdiskrc"; -$rcfile = File::Spec->canonpath($rcfile); - -my $c = read_rcfile($rcfile); - -$db ||= $c->get_db || $ENV{'NEB_DB'}; -$dbuser ||= $c->get_dbuser || $ENV{'NEB_USER'}; -$dbpass ||= $c->get_dbpass || $ENV{'NEB_PASS'}; -$pidfile ||= $c->get_pidfile || "/var/tmp/nebdiskd"; -my $mounts = $c->get_mounts; -my $poll_interval = $c->get_poll_interval || 5; - -if ($restart || $stop) { - my $status = kill_pid_file($pidfile); - exit($status) if $stop; -} - -$c->set_db($db); -$c->set_dbuser($dbuser); -$c->set_dbpass($dbpass); -$c->set_pidfile($pidfile); -$c->set_poll_interval($poll_interval); -$c->write; - -pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; -pod2usage( -msg => "Required options: --db --user --pass", -exitval => 2 ) - unless $db && $dbuser && $dbpass; - -daemonize( - $<, # User - $), # Group - $pidfile, # PID file -) unless $debug; - -$SIG{TERM} = sub { unlink_pid_file($pidfile); exit(); }; -$SIG{INT} = $SIG{TERM}; -$SIG{HUP} = sub { $c = read_rcfile($rcfile) }; - -my $dbh = setup_db( - db => $db, - dbuser => $dbuser, - dbpass => $dbpass, - ); - -poll_mounts( - dbh => $dbh, - poll_interval => $poll_interval, - debug => $debug, - ) or die "poll_mounts() should not have returned"; - -sub poll_mounts -{ - my %p = @_; - - my $dbh = $p{dbh} or return; - my $poll_interval = $p{poll_interval} || 60; - my $debug = $p{debug} || 0; - - my $lxs = Sys::Statistics::Linux::DiskUsage->new; - - while (1) { - # list of mount points to stat so that the automounter will mount these - # volumes if they have been unmounted. - stat_dirs($mounts); - - eval { - my $query = $dbh->prepare_cached("INSERT INTO mount VALUES(?, ?, ?)"); - $dbh->do("DELETE FROM mount"); - - print "flushed mount table\n" if $debug; - - my $stats = $lxs->get; - foreach my $dev (keys %$stats) { - my $mnt = $stats->{$dev}; - my %mount; - $query->execute(@$mnt{qw( mountpoint total usage )}); - print "adding $mnt->{mountpoint} to db\n" if $debug; - } - - $dbh->do("call getmountedvol()"); - - $dbh->commit; - }; - if ($@) { - $db->rollback; - warn $@; - } - - sleep $poll_interval; - } -} - -sub read_rcfile -{ - my $rcfile = shift; - - return unless defined $rcfile; - - if (!-f $rcfile) { - open(my $fh, '>', $rcfile) or die "can't open file: $!"; - close($fh) or die "can't close file:$!"; - } - - return Config::YAML->new( - config => $rcfile, - output => $rcfile, - ); -} - - -sub setup_db -{ - my %p = @_; - - return unless defined $p{db} - and defined $p{dbuser} - and defined $p{dbpass}; - - my $sql = Nebulous::Server::SQL->new; - - my $dbh = DBI->connect( - "DBI:mysql:database=$p{db}:host=localhost", - $p{dbuser}, - $p{dbpass}, - { - RaiseError => 1, - PrintError => 1, - AutoCommit => 0, - }, - ); - - eval { - $dbh->do( $sql->set_transaction_model ); - $dbh->commit; - }; - if ($@) { - $db->rollback; - die $@; - } - - return $dbh; -} - - -sub stat_dirs -{ - my $mounts = shift; - - return unless defined $mounts; - - foreach my $path (@$mounts) { - stat File::Spec->canonpath($path) or warn "can not stat path: $path"; - print "stated $path\n" if $debug; - } -} - -# -# This function, originally named check_pid_file() was copied from -# Net::Server::Daemonize '0.05' licensed under the Perl license. It has been -# renamed and modified to kill off process who's PID value is stored in pidfile. -# - -sub kill_pid_file { - my $pid_file = shift; - - ### no pid_file = return success - return 1 unless -e $pid_file; - - ### get the currently listed pid - if( ! open(_PID,$pid_file) ){ - die "Couldn't open existant pid_file \"$pid_file\" [$!]\n"; - } - my $_current_pid = <_PID>; - close _PID; - my $current_pid = $_current_pid =~ /^(\d{1,10})/ ? $1 : die "Couldn't find pid in existing pid_file"; - - my $exists = undef; - - ### try a proc file system - if( -d '/proc' ) { - $exists = -e "/proc/$current_pid"; - - ### try ps - #}elsif( -x '/bin/ps' ){ # not as portable - # the ps command itself really isn't portable - # this follows BSD syntax ps (BSD's and linux) - # this will fail on Unix98 syntax ps (Solaris, etc) - }elsif( `ps h o pid p $$` =~ /^\s*$$\s*$/ ){ # can I play ps on myself ? - $exists = `ps h o pid p $current_pid`; - - } - - ### running process exists, ouch - if( $exists ){ - - if( $current_pid == $$ ){ - warn "Pid_file created by this same process. Doing nothing.\n"; - return 1; - }else{ - kill 'TERM', $current_pid - or die "Failed to signal process ($current_pid)"; - unlink $pid_file || die "Couldn't remove pid_file \"$pid_file\" [$!]\n"; - return 1; - - } - } -} - -__END__ - -=pod - -=head1 NAME - -nebdiskd - Nebulous mounted volume capacity monitoring daemon - -=head1 SYNOPSIS - - nebdiskd [--db ] [--user ] [--pass ] [--debug] [--pidfile ] [--stop] [--restart] [--verbose] - -=head1 DESCRIPTION - -This program looks for mounted volumes, at a configurable interval, and records -statistics about them into a database. - -=head1 OPTIONS - -=over 4 - -=item * --db|-d - -Name of database (C) to write too. - -Optional if defined in the F<.nebdiskdrc> file or the appropriate environment -variable is set. - -=item * --user|-u - -Username to authenticate with. - -Optional if defined in the F<.nebdiskdrc> file or the appropriate environment -variable is set. - -=item * --pass|-p - -Password to authenticate with. - -Optional if defined in the F<.nebdiskdrc> file or the appropriate environment -variable is set. - -=item * --debug - -This flag prevents the program from "daemonizing" so output can be sent to -C/C and a debugger used on the running process. - -=item * --pidfile - -Filename to log the running daemon's PID too. - -Optional, if this option is omitted and no value is defined in the -F<.nebdiskrc> then no pidfile is created. - -=item * --stop|-s - -Uses the pidfile to kill an already running daemon. - -=item * --restart|-r - -Uses the pidfile to kill an already running daemon and then starts a new -instance. - -=item * --verbose|-r - -Turns on informational/debugging messages to be sent to the -C/C. This option is probably not very usefully unless combined -with C<--debug>. - -=back - -=head1 ENVIRONMENT - -These environment variables may be used in place of the specified command line -options. All command line option will override the corresponding environment -value. - -=over 4 - -=item * C - -Equivalent to --db|-d - -=item * C - -Equivalent to --user|-u - -=item * C - -Equivalent to --pass|-p - -=back - -=head1 RCFILE - -This program will attempt to read an C from F<$HOME/.nebdiskrc> and if -found will use it's values to override program defaults. Please not that the -precedence for values is: command line, rcfile, environment variables. - -The format of the C is in L format and uses the following values: - - --- - db: nebulous - dbpass: '@neb@' - dbuser: nebulous - mounts: - - /mnt - - /tmp - - /usr - pidfile: /var/tmp/nebdiskd - poll_interval: 5 - -The values C, C, C, and C have the same semantics -as their command line and/or environment variable equivalents. - -=over 4 - -=item * C - -A list of "paths" to C before mounted volumes are polled. The propose -of this option is to attempt to keep "automounted" volumes mounted while this -program is running. - -This value may be omitted or left blank. - -=item * C - -The number of seconds to wait between checks for mounted volumes. - -This value may be omitted or left blank. The default value is C<60>s. - -=back - -=head1 CREDITS - -Just me, myself, and I. - -=head1 SUPPORT - -Please contact the author directly via e-mail. - -=head1 AUTHOR - -Joshua Hoblitt - -=head1 COPYRIGHT - -Copyright (C) 2007 Joshua Hoblitt. All rights reserved. - -This program is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free Software -Foundation; either version 2 of the License, or (at your option) any later -version. - -This program is distributed in the hope that it will be useful, but WITHOUT ANY -WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A -PARTICULAR PURPOSE. See the GNU General Public License for more details. - -You should have received a copy of the GNU General Public License along with -this program; if not, write to the Free Software Foundation, Inc., 59 Temple -Place - Suite 330, Boston, MA 02111-1307, USA. - -The full text of the license can be found in the L Pod as supplied -with Perl 5.8.1 and later. - -=head1 SEE ALSO - -L, L, L, L, L - -=cut Index: trunk/Nebulous/lib/Nebulous/Client.pm =================================================================== --- trunk/Nebulous/lib/Nebulous/Client.pm (revision 16566) +++ trunk/Nebulous/lib/Nebulous/Client.pm (revision 17073) @@ -1,5 +1,5 @@ # Copyright (c) 2004 Joshua Hoblitt # -# $Id: Client.pm,v 1.39 2008-02-05 04:57:56 eugene Exp $ +# $Id: Client.pm,v 1.40 2008-03-20 23:21:58 jhoblitt Exp $ package Nebulous::Client; @@ -8,5 +8,5 @@ use warnings FATAL => qw( all ); -our $VERSION = '0.02'; +our $VERSION = '0.07'; use File::Copy qw(); Index: trunk/Nebulous/lib/Nebulous/Keys.pod =================================================================== --- trunk/Nebulous/lib/Nebulous/Keys.pod (revision 16566) +++ (revision ) @@ -1,145 +1,0 @@ -=pod - -=head1 NAME - -Nebulous::Keys - Nebulous Keys Explained - -=head1 DESCRIPTION - -The Nebulous system interprets it's storage object keys in a I -magical manner. It supports both plain vanilla C and keys in the -form of an L. In the L form a specific storage volume can be implied -(as a request, not a requirement). Both key forms are subject to mangling such -that I the key I like a C semantics file path, it is -canocalized. - -=head1 RESERVED SYNTAX - -This particular syntax is disallowed and is reserved for future use. - - / - -=head1 EXAMPLES - -=head2 Key Strings - - key: foo/bar/baz/quix - mangled to: foo/bar/baz/quix - volume: any - - key: /foo/bar/baz/quix - mangled to: foo/bar/baz/quix - volume: any - - key: //foo/bar/baz/quix - mangled to: foo/bar/baz/quix - volume: any - - key: ///foo/bar/baz/quix - mangled to: foo/bar/baz/quix - volume: any - - key: foo////bar/baz/quix - mangled to: foo/bar/baz/quix - volume: any - - key: foo/bar/baz/quix/ - mangled to: foo/bar/baz/quix - volume: any - -=head2 URI w/ volume name - -neb:/// - - key: neb://foo/bar/baz/quix - mangled to: bar/baz/quix - volume: foo - - key: neb://foo//bar/baz/quix - mangled to: bar/baz/quix - volume: foo - - key: neb://foo///bar/baz/quix - mangled to: bar/baz/quix - volume: foo - - key: neb://foo/bar///baz/quix - mangled to: bar/baz/quix - volume: foo - - key: neb://foo/bar/baz/quix/ - mangled to: bar/baz/quix - volume: foo - -=head2 URI w/o volume name - -neb:/ - - key: neb:/foo/bar/baz/quix - mangled to: foo/bar/baz/quix - volume: any - - key: neb:///foo/bar/baz/quix - mangled to: foo/bar/baz/quix - volume: any - - key: neb://///foo/bar/baz/quix - mangled to: foo/bar/baz/quix - volume: any - -=head2 Forbidden Keys - -=head3 Key with whitespace - - "/ foo/bar/baz/quix" - " /foo/bar/baz/quix" - "/foo/bar/baz/quix " - -=head3 URI with whitespace - - "neb ://foo/bar/baz/quix" - "neb:// foo/bar/baz/quix" - " neb://foo/bar/baz/quix" - "neb://foo/bar/baz/quix " - -=head3 URI with out a volume requires a leading slash - - neb:foo/bar/baz/quix - -=head1 CREDITS - -Just me, myself, and I. - -=head1 SUPPORT - -Please contact the author directly via e-mail. - -=head1 AUTHOR - -Joshua Hoblitt - -=head1 COPYRIGHT - -Copyright (C) 2008 Joshua Hoblitt. All rights reserved. - -This program is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free Software -Foundation; either version 2 of the License, or (at your option) any later -version. - -This program is distributed in the hope that it will be useful, but WITHOUT ANY -WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A -PARTICULAR PURPOSE. See the GNU General Public License for more details. - -You should have received a copy of the GNU General Public License along with -this program; if not, write to the Free Software Foundation, Inc., 59 Temple -Place - Suite 330, Boston, MA 02111-1307, USA. - -The full text of the license can be found in the LICENSE file included with -this module, or in the L Pod as supplied with Perl 5.8.1 and later. - -=head1 SEE ALSO - -L, L, L - -=cut Index: trunk/Nebulous/lib/Nebulous/Server.pm =================================================================== --- trunk/Nebulous/lib/Nebulous/Server.pm (revision 16566) +++ (revision ) @@ -1,1336 +1,0 @@ -# Copyright (c) 2004 Joshua Hoblitt -# -# $Id: Server.pm,v 1.54 2008-02-21 23:21:09 jhoblitt Exp $ - -package Nebulous::Server; - -use strict; -use warnings FATAL => qw( all ); - -our $VERSION = '0.06'; - -use base qw( Class::Accessor::Fast ); - -use DBI; -use Digest::SHA1 qw( sha1_hex ); -use File::ExtAttr qw( setfattr ); -use File::Path; -use File::Spec; -use Log::Log4perl; -use Nebulous::Server::Config; -use Nebulous::Server::Log; -use Nebulous::Server::SQL; -use Nebulous::Util qw( :standard ); -use Params::Validate qw( validate_pos SCALAR SCALARREF ); -use URI::file; - -__PACKAGE__->mk_accessors(qw( log sql config )); - -use constant SUBPATH_DEPTH => 2; - -sub new { - my $class = shift; - - # let Nebulous::Server::Config validate our params - my $config = Nebulous::Server::Config->init( @_ ); - - # log4perl is not avaliable until we call init() - Nebulous::Server::Log->init($config); - my $log = Log::Log4perl::get_logger( "Nebulous::Server" ); - - my $sql = Nebulous::Server::SQL->new; - - $log->debug( "entered - @_" ); - - my $db; - eval { - $db = DBI->connect( - $config->dsn, - $config->dbuser, - $config->dbpasswd, - { - RaiseError => 1, - PrintError => 0, - AutoCommit => 0, - }, - ); - - $db->do( $sql->set_transaction_model ); - - $db->commit; - $log->debug("commit"); - }; - if ( $@ ) { - $db->rollback if $db; - $log->debug("rollback"); - $log->logdie( "database error: $@" ); - } - - $log->debug( "connected to database: ", sub { $db->data_sources; } ); - - my $self = bless {}, ref $class || $class; - $self->log($log); - $self->sql($sql); - $self->db($db); - $self->config($config); - - $log->debug( "leaving" ); - - return $self; -} - -sub db { - my $self = shift; - - if (@_) { - $self->{db} = $_[0]; - return $self; - } - - my $log = $self->log; - my $sql = $self->sql; - my $config = $self->config; - - # if the dbh is still alive, return it - if (defined $self->{db} and $self->{db}->ping) { - $log->debug("db handle is still alive"); - return $self->{db}; - } - # otherwise create a new connection - $log->debug("db handle is dead"); - - # if we're running under mod_perl & Apache::DBI is loaded we want to - # reconnect to the database everytime the dbh is requested. The rational is - # that if we're running under mod_perl this is probably a log running - # processes and the database might have gone away on us. Apache::DBI will - # take care of getting a valid dbh back. - if ($INC{'Apache/DBI.pm'} && $ENV{MOD_PERL}) { - my $db; - eval { - $db = DBI->connect( - $config->dsn, - $config->dbuser, - $config->dbpasswd, - { - RaiseError => 1, - PrintError => 0, - AutoCommit => 0, - }, - ); - - $db->do( $sql->set_transaction_model ); - - $db->commit; - $log->debug("commit"); - }; - if ( $@ ) { - $db->rollback if $db; - $log->debug("rollback"); - $log->logdie( "database error: $@" ); - } - - $self->{db} = $db; - - return $db; - } - - return $self->{db}; -} - - -sub create_object -{ - my $self = shift; - - my ($key, $vol_name) = validate_pos(@_, - { - type => SCALAR, - }, - { - type => SCALAR, - callbacks => { - # check that the volume requested is valid - 'is valid volume name' => sub { $self->_is_valid_volume_name($_[0]) }, - }, - optional => 1, - }, - ); - - my $log = $self->log; - my $sql = $self->sql; - my $db =$self->db; - - $log->debug( "entered - @_" ); - - { - my $volume; - ($volume, $key) = parse_neb_key($key); - # vol_name overrides the key implied volume - $vol_name ||= $volume; - } - - if (defined $vol_name and !$self->_is_valid_volume_name($vol_name)) { - die "$vol_name is not a valid volume name" - } - - my ($vol_id, $vol_path, $vol_xattr) = $self->_get_storage_volume($vol_name); - - my $uri; - eval { - { - # create storage_object - my $query = $db->prepare_cached( $sql->new_object ); - $query->execute('NULL', $key); - } - - my $so_id; - { - # get object ID - my $query = $db->prepare_cached( $sql->last_insert_id ); - $query->execute; - ($so_id) = $query->fetchrow_array; - # XXX finish seems to be required when using LAST_INSERT_ID() or we - # get a warning about the stmt handling still be active the next - # time LAST_INSERT_ID() is invoked - $query->finish; - } - - { - # create storage_object_attr - my $query = $db->prepare_cached( $sql->new_object_attr ); - $query->execute($so_id); - } - - { - # create instance with no URI - my $query = $db->prepare_cached( $sql->new_object_instance ); - $query->execute($vol_id); - } - - my $ins_id; - { - # get instance ID - my $query = $db->prepare_cached( $sql->last_insert_id ); - $query->execute; - ($ins_id) = $query->fetchrow_array; - # XXX finish seems to be required when using LAST_INSERT_ID() or we - # get a warning about the stmt handling still be active the next - # time LAST_INSERT_ID() is invoked - $query->finish; - } - - # Unfortunately, since we want to use the instance row's ID as part of the - # actual on disk file name we can't try to create the file until after - # we've create both a new storage_storage object and instance. - - # TODO add some stuff here to retry if unsucessful - $uri = $self->_create_empty_instance_file($key, $so_id, $ins_id, $vol_path, $vol_xattr); - $log->debug("created $uri on volume ID: $vol_id"); - - { - # update the instance with URI & vol_id that the file is on - my $query = $db->prepare_cached( $sql->update_instance_uri ); - # vol_id, uri, ins_id - $query->execute($vol_id, "$uri", $ins_id); - } - - $db->commit; - $log->debug("commit"); - }; - if ($@) { - $db->rollback; - $log->debug("rollback"); - $log->logdie("error: $@"); - } - - $log->debug("leaving"); - - return "$uri"; -} - -sub rename_object -{ - my $self = shift; - - my ($key, $newkey) = validate_pos(@_, - { - type => SCALAR, - callbacks => { - 'is valid object key' => sub { $self->_is_valid_object_key($_[0]) }, - }, - }, - # make sure the "newkey" doesn't already exist - { - type => SCALAR, - callbacks => { - 'is not valid object key' => sub { not $self->_is_valid_object_key($_[0]) }, - }, - }, - ); - - my $log = $self->log; - my $sql = $self->sql; - my $db =$self->db; - - $log->debug("entered - @_"); - - # ignore volumes - $key = parse_neb_key($key); - $newkey = parse_neb_key($newkey); - - eval { - # rename storage_object - my $query = $db->prepare_cached($sql->rename_object); - # this SQL statment takes the new key name as the first param - my $rows = $query->execute($newkey, $key); - - # if we affected more then one row something very bad has happened. - unless ($rows == 1) { - $log->logdie("affected row count is $rows instead of 1"); - } - - $db->commit; - $log->debug("commit"); - }; - if ($@) { - $db->rollback; - $log->debug("rollback"); - $log->logdie("database error: $@"); - } - - $log->debug("leaving"); - - return $newkey; -} - - -sub replicate_object -{ - my $self = shift; - - my ($key, $vol_name) = validate_pos(@_, - { - type => SCALAR, - callbacks => { - 'is valid object key' => sub { $self->_is_valid_object_key($_[0]) }, - }, - }, - { - type => SCALAR, - callbacks => { - # check that the volume name requested is valid - 'is valid volume name' => sub { $self->_is_valid_volume_name($_[0]) }, - }, - optional => 1, - }, - ); - - my $log = $self->log; - my $sql = $self->sql; - my $db =$self->db; - - $log->debug("entered - @_"); - - { - my $volume; - ($volume, $key) = parse_neb_key($key); - # vol_name overrides the key implied volume - $vol_name ||= $volume; - } - - if (defined $vol_name and !$self->_is_valid_volume_name($vol_name)) { - die "$vol_name is not a valid volume name" - } - - my ($vol_id, $vol_path, $vol_xattr) = $self->_get_storage_volume($vol_name); - - my $uri; - eval { - my $so_id; - { - my $query = $db->prepare_cached( $sql->get_object_instances ); - my $rows = $query->execute($key, 1); - - unless ( $rows > 0 ) { - $query->finish; - $db->rollback; - $log->debug("rollback"); - $log->logdie( "storage object does not exist" ); - } - - $so_id = $query->fetchrow_hashref->{ 'so_id' }; - $query->finish; - } - - { - my $query = $db->prepare_cached( $sql->new_instance ); - $query->execute($so_id, $vol_id); - } - - my $ins_id; - { - my $query = $db->prepare_cached( $sql->last_insert_id ); - $query->execute(); - ($ins_id) = $query->fetchrow_array; - # XXX finish seems to be required when using LAST_INSERT_ID() or we - # get a warning about the stmt handling still be active the next - # time LAST_INSERT_ID() is invoked - $query->finish; - } - - # Unfortunately, since we want to use the instance row's ID as part of - # the actual on disk file name we can't try to create the file until - # after we've create both a new storage_storage object and instance. - - # TODO add some stuff here to retry if unsucessful - $uri = $self->_create_empty_instance_file($key, $so_id, $ins_id, $vol_path, $vol_xattr); - - { - my $query = $db->prepare_cached( $sql->update_instance_uri ); - # vol_id, uri, ins_id - $query->execute($vol_id, $uri, $ins_id); - } - - $db->commit; - $log->debug("commit"); - }; - if ($@) { - $db->rollback; - $log->debug("rollback"); - $log->logdie("error: $@"); - } - - $log->debug("leaving"); - - return "$uri"; -} - -sub lock_object -{ - my $self = shift; - - my ( $key, $type ) = validate_pos( @_, - { - type => SCALAR, - callbacks => { - 'is valid object key' => sub { $self->_is_valid_object_key($_[0]) }, - }, - }, - { - type => SCALAR, - callbacks => { - 'is read or write' => sub { $_[0] =~ /^(?:read|write)$/ }, - }, - }, - ); - - my $log = $self->log; - my $sql = $self->sql; - my $db =$self->db; - - $log->debug( "entered - @_" ); - - # ignore volume - $key = parse_neb_key($key); - - my $so_id; - my $read_lock; - my $write_lock; - my $query; - - eval { - { - # this will set update locks - $query = $db->prepare_cached( $sql->get_object_locks ); - my $rows = $query->execute( $key ); - unless ( $rows == 1 ) { - $log->logdie( "storage object does not exist" ); - } - - my $row = $query->fetchrow_hashref; - $query->finish; - - $so_id = $row->{ 'so_id' }; - $read_lock = $row->{ 'read_lock' }; - $write_lock = $row->{ 'write_lock' }; - } - - if ($type eq 'write') { - # can't set a write lock twice and - # can't set a write lock if there are read locks - if ($write_lock) { - $log->logdie("can not write lock twice"); - } - - if ($read_lock > 0) { - $log->logdie("can not write lock after read lock"); - } - - { - my $query = $db->prepare_cached( $sql->set_write_lock ); - my $rows = $query->execute($key); - - # if we affected more then one row something very bad has happened. - unless ($rows == 1) { - $log->logdie("affected row count is $rows instead of 1"); - } - - } - } elsif ($type eq 'read') { - # can't set a read lock if there's a write lock - if ($write_lock) { - $log->logdie("can not read lock after write lock"); - } - - { - my $query = $db->prepare_cached( $sql->increment_read_lock ); - my $rows = $query->execute($key); - - # if we affected more then one row something very bad has happened. - unless ($rows == 1) { - $log->logdie("affected row count is $rows instead of 1"); - } - } - } - - $db->commit; - $log->debug("commit"); - }; - if ($@) { - $db->rollback; - $log->debug("rollback"); - $log->logdie("error: $@"); - } - - $log->debug("leaving"); - - return 1; -} - -sub unlock_object -{ - my $self = shift; - - my ( $key, $type ) = validate_pos( @_, - { - type => SCALAR, - callbacks => { - 'is valid object key' => sub { $self->_is_valid_object_key($_[0]) }, - }, - }, - { - type => SCALAR, - callbacks => { - 'is read or write' => sub { $_[0] =~ /^(?:read|write)$/ }, - }, - }, - ); - - my $log = $self->log; - my $sql = $self->sql; - my $db =$self->db; - - $log->debug( "entered - @_" ); - - # ignore volume - $key = parse_neb_key($key); - - my $so_id; - my $read_lock; - my $write_lock; - my $query; - - eval { - { - # this will set update locks - $query = $db->prepare_cached( $sql->get_object_locks ); - my $rows = $query->execute($key); - unless ($rows == 1) { - $log->logdie("storage object does not exist"); - } - - my $row = $query->fetchrow_hashref; - $query->finish; - - $so_id = $row->{ 'so_id' }; - $read_lock = $row->{ 'read_lock' }; - $write_lock = $row->{ 'write_lock' }; - } - - if ($type eq 'write') { - # can't remove a write lock if it doesn't exist - if ($read_lock) { - $log->logdie("can not have a write lock under a read lock"); - } - - unless ($write_lock) { - $log->logdie("can not remove non-existant write lock"); - } - - { - my $query = $db->prepare_cached( $sql->delete_write_lock ); - my $rows = $query->execute($key); - - # if we affected more then one row something very bad has happened. - unless ($rows == 1) { - $log->logdie("affected row count is $rows instead of 1"); - } - } - } elsif ($type eq 'read') { - # can't remove a read lock if there's a write lock and - # can't remove a read lock if there aren't any - if ($write_lock) { - $log->logdie("can not have a read lock under a write lock"); - } - - if ($read_lock == 0) { - $log->logdie("can not remove non-existant read lock"); - } - - { - my $query = $db->prepare_cached( $sql->decrement_read_lock ); - my $rows = $query->execute($key); - - # if we affected more then one row something very bad has happened. - unless ($rows == 1) { - $log->logdie("affected row count is $rows instead of 1"); - } - - } - } - $db->commit; - $log->debug("commit"); - }; - if ($@) { - $db->rollback; - $log->debug("rollback"); - $log->logdie("error: $@"); - } - - $log->debug( "leaving" ); - - return 1; -} - - -sub setxattr_object -{ - my $self = shift; - - my ($key, $name, $value, $flags) = validate_pos(@_, - { - type => SCALAR, - callbacks => { - 'is valid object key' => sub { $self->_is_valid_object_key($_[0]) }, - }, - }, - { - type => SCALAR, - }, - { - type => SCALAR, - }, - { - type => SCALAR, - callbacks => { - 'is read or write' => sub { $_[0] =~ /^(?:create|replace)$/i }, - }, - }, - ); - - my $log = $self->log; - my $sql = $self->sql; - my $db =$self->db; - - $log->debug("entered - @_"); - - # ignore volume - $key = parse_neb_key($key); - - eval { - my $query; - - if ($flags eq 'create') { - $query = $db->prepare_cached( $sql->new_object_xattr ); - } else { - # replace - $query = $db->prepare_cached( $sql->replace_object_xattr ); - } - - # name, value, ext_id - my $rows = $query->execute($name, $value, $key); - - # if we affected more then one row something very bad has happened. - if ($flags eq 'create') { - unless ($rows == 1) { - $log->logdie( "affected row count is $rows instead of 1" ); - } - } else { - unless ($rows == 2) { - $log->logdie( "affected row count is $rows instead of 2" ); - } - } - }; - if ($@) { - $db->rollback; - $log->debug("rollback"); - $log->logdie("database error: $@"); - } - - eval { - $db->commit; - $log->debug("commit"); - }; - if ($@) { - $db->rollback; - $log->debug("rollback"); - $log->logdie("database error: $@"); - } - - $log->debug("leaving"); - - return 1; -} - - -sub getxattr_object -{ - my $self = shift; - - my ($key, $name) = validate_pos(@_, - { - type => SCALAR, - callbacks => { - 'is valid object key' => sub { $self->_is_valid_object_key($_[0]) }, - }, - }, - { - type => SCALAR, - }, - ); - - my $log = $self->log; - my $sql = $self->sql; - my $db =$self->db; - - $log->debug("entered - @_"); - - # ignore volume - $key = parse_neb_key($key); - - my $query; - eval { - $query = $db->prepare_cached( $sql->get_object_xattr ); - # ext_id, name - my $rows = $query->execute($key, $name); - - # if we affected more then one row something very bad has happened. - unless ($rows == 1) { - $log->logdie( "affected row count is $rows instead of 1" ); - } - }; - if ($@) { - $db->rollback; - $log->debug("rollback"); - $log->logdie("database error: $@"); - } - - my $row = $query->fetchrow_hashref; - my $value = $row->{ 'value' }; - $query->finish; - - $log->debug("leaving"); - - return $value; -} - - -sub listxattr_object -{ - my $self = shift; - - my ($key) = validate_pos(@_, - { - type => SCALAR, - callbacks => { - 'is valid object key' => sub { $self->_is_valid_object_key($_[0]) }, - }, - }, - ); - - my $log = $self->log; - my $sql = $self->sql; - my $db =$self->db; - - $log->debug("entered - @_"); - - # ignore volume - $key = parse_neb_key($key); - - my $query; - eval { - $query = $db->prepare_cached( $sql->list_object_xattr ); - # ext_id - my $rows = $query->execute($key); - }; - if ($@) { - $db->rollback; - $log->debug("rollback"); - $log->logdie("database error: $@"); - } - - my @xattrs; - while (my $row = $query->fetchrow_hashref) { - push @xattrs, $row->{ 'name' }; - } - - $log->debug("leaving"); - - return @xattrs; -} - - -sub removexattr_object -{ - my $self = shift; - - my ($key, $name) = validate_pos(@_, - { - type => SCALAR, - callbacks => { - 'is valid object key' => sub { $self->_is_valid_object_key($_[0]) }, - }, - }, - { - type => SCALAR, - }, - ); - - my $log = $self->log; - my $sql = $self->sql; - my $db =$self->db; - - $log->debug("entered - @_"); - - # ignore volume - $key = parse_neb_key($key); - - my $query; - eval { - $query = $db->prepare_cached( $sql->remove_object_xattr ); - # ext_id, name - my $rows = $query->execute($key, $name); - - # if we affected more then one row something very bad has happened. - unless ($rows == 1) { - $log->logdie( "affected row count is $rows instead of 1" ); - } - }; - if ($@) { - $db->rollback; - $log->debug("rollback"); - $log->logdie("database error: $@"); - } - - eval { - $db->commit; - $log->debug("commit"); - }; - if ($@) { - $db->rollback; - $log->debug("rollback"); - $log->logdie("database error: $@"); - } - - $log->debug("leaving"); - - return 1; -} - - -sub find_objects -{ - my $self = shift; - - my ( $pattern ) = validate_pos( @_, - { - type => SCALAR, - optional => 1, - }, - ); - - my $log = $self->log; - my $sql = $self->sql; - my $db =$self->db; - - $log->debug( "entered - @_" ); - - unless ($pattern) { - $log->debug( "leaving" ); - return []; - } - - # attempt to strip off neb:// if it exists - if ($pattern =~ m|^neb:|) { - $pattern = parse_neb_key($pattern); - } - - my $query; - eval { - $query = $db->prepare_cached( $sql->find_objects ); - $query->execute( $pattern ); - }; - $log->logdie( "database error: $@" ) if $@; - - my @keys; - - while ( my $row = $query->fetchrow_hashref ) { - my $key = $row->{ 'ext_id' }; - push @keys, $key if $key; - } - - $log->debug( "no keys found" ) unless ( scalar @keys ); - - $log->debug( "leaving" ); - - return \@keys; -} - - -sub find_instances -{ - my $self = shift; - - my ($key, $vol_name) = validate_pos(@_, - { - type => SCALAR, - callbacks => { - 'is valid object key' => sub { $self->_is_valid_object_key($_[0]) }, - }, - }, - { - type => SCALAR, - callbacks => { - # check that the volume name requested is valid - 'is valid volume name' => sub { $self->_is_valid_volume_name($_[0]) }, - }, - optional => 1, - }, - ); - - my $log = $self->log; - my $sql = $self->sql; - my $db =$self->db; - - $log->debug("entered - @_"); - - { - my $volume; - ($volume, $key) = parse_neb_key($key); - if (defined $volume) { - die "$volume is not a valid volume name" - unless $self->_is_valid_volume_name($volume); - } - $vol_name ||= $volume; - } - - my $query; - eval { - if ($vol_name) { - $query = $db->prepare_cached( $sql->get_object_instances_by_vol_name ); - # ext_id, name, available - my $rows = $query->execute($key, $vol_name, 1); - unless ($rows > 0) { - $query->finish; - $log->logdie("no instances on storage volume: $vol_name or volume is not available"); - } - } else { - $query = $db->prepare_cached( $sql->get_object_instances ); - # ext_id, available - my $rows = $query->execute($key, 1); - unless ($rows > 0) { - $query->finish; - $log->logdie("no instances available"); - } - } - }; - $log->logdie("database error: $@") if $@; - - my @locations; - - while (my $row = $query->fetchrow_hashref) { - my $instance = $row->{ 'uri' }; - push @locations, $instance if $instance; - } - - # XXX remove this? - $log->logdie("no instances found") unless (scalar @locations); - - $log->debug("found: @locations"); - - $log->debug("leaving"); - - return \@locations; -} - - -sub delete_instance -{ - my $self = shift; - - my ( $uri ) = validate_pos( @_, - { - type => SCALAR|SCALARREF, - }, - ); - - my $log = $self->log; - my $sql = $self->sql; - my $db =$self->db; - - $log->debug( "entered - @_" ); - - eval { - my $so_id; - my $instances; - # get so_id - { - my $query = $db->prepare_cached( $sql->get_object_from_uri ); - my $rows = $query->execute( $uri ); - - unless ( $rows > 0 ) { - $query->finish; - $log->logdie( "no instance is associated with uri" ); - } - - $so_id = $query->fetchrow_hashref->{ 'so_id' }; - $query->finish; - - } - - { - my $query = $db->prepare_cached( $sql->get_instance_count ); - $query->execute( $so_id ); - - $instances = $query->fetchrow_hashref->{ 'count(ins_id)' }; - $query->finish; - } - - # remove instance - { - my $query = $db->prepare_cached( $sql->delete_instance ); - my $rows = $query->execute( $uri ); - $query->finish; - - # if we affected something other then two rows something very bad - # has happened - unless ( $rows == 1 ) { - $log->logdie( "affected row count is $rows instead of 1" ); - } - } - - # if we just deleted the last instance associated with a storage object - # remove it too - if ( $instances == 1 ) { - # we just removed the last instance - my $query = $db->prepare_cached( $sql->delete_object ); - my $rows = $query->execute( $so_id ); - $query->finish; - - # TODO: this will have to be changed in order to support hardlinks - unless ( $rows == 1 ) { - $log->logdie( "affected row count is $rows instead of 2" ); - } - } - - $db->commit; - $log->debug("commit"); - }; - if ( $@ ) { - $db->rollback; - $log->debug("rollback"); - $log->logdie( "database error: $@" ); - } - - $log->debug( "leaving" ); - - return 1; -} - - -sub stat_object -{ - my $self = shift; - - my ( $key ) = validate_pos( @_, - { - type => SCALAR, - callbacks => { - 'is valid object key' => sub { $self->_is_valid_object_key($_[0]) }, - }, - }, - ); - - my $log = $self->log; - my $sql = $self->sql; - my $db =$self->db; - - $log->debug("entered - @_"); - - # ignore volume - $key = parse_neb_key($key); - - my $stat; - eval { - my $query = $db->prepare_cached( $sql->stat_object ); - my $rows = $query->execute($key); - - unless ($rows == 1) { - $log->logdie("no storage object found"); - } - - $stat = $query->fetchrow_arrayref; - $query->finish; - }; - if ( $@ ) { - $db->rollback; - $log->debug("rollback"); - $log->logdie("database error: $@"); - } - - $log->debug("leaving"); - - return $stat; -} - - -sub _get_storage_volume -{ - my $self = shift; - - my $log = $self->log; - my $sql = $self->sql; - my $db =$self->db; - - no warnings qw( uninitialized ); - $log->debug( "entered - @_" ); - use warnings; - - my $name = shift; - - my ($vol_id, $vol_path, $xattr); - eval { - # TODO cache this? - my $query; - my $rows; - if ( $name ) { - $query = $db->prepare_cached( $sql->get_storage_volume_by_name ); - # %free, name, avaiable, allocate - $rows = $query->execute(0.95, $name, 1, 1); - # XXX destinguish between non-existant and unaviable - unless ($rows > 0) { - $query->finish; - $log->logdie("storage volume: $name is not available"); - } - # when matching by name we shouldn't ever match more than once - if ($rows > 1) { - $query->finish; - $log->logdie("affected row count is $rows instead of 1"); - } - } else { - $query = $db->prepare_cached( $sql->get_storage_volume ); - # %free, avaiable, allocate - $rows = $query->execute(0.95, 1, 1); - # there has to be atleast one storage volume - unless ($rows > 0) { - $query->finish; - $log->logdie("no storage volume is available"); - } - } - - my $free; - ($vol_id, $vol_path, $xattr, $free) = $query->fetchrow_array; - $query->finish; - }; - if ($@) { - $db->rollback; - $log->debug("rollback"); - $log->logdie("database error: $@"); - } - - $log->logdie("failed to find a suitable volume" ) - unless defined $vol_id and defined $vol_path; - - $log->debug( "leaving" ); - - return ($vol_id, $vol_path, $xattr); -} - - -sub _is_valid_object_key -{ - my ($self, $key) = @_; - - my $log = $self->log; - my $sql = $self->sql; - my $db =$self->db; - - my $ext_id; - eval { - my $query = $db->prepare_cached( $sql->get_object ); - $query->execute($key); - ($ext_id) = $query->fetchrow_array; - $query->finish; - }; - if ($@) { - $db->rollback; - $log->debug("rollback"); - $log->logdie( "database error: $@" ); - } - - if (defined $ext_id) { - return 1; - } - - return; -} - - -sub _is_valid_volume_name -{ - my ($self, $vol_name) = @_; - - my $log = $self->log; - my $sql = $self->sql; - my $db =$self->db; - - my ($vol_id, $vol_path); - eval { - my $query = $db->prepare_cached( $sql->get_volume_by_name ); - $query->execute( $vol_name ); - my $free; - ($vol_id, $vol_path, $free) = $query->fetchrow_array; - $query->finish; - }; - if ($@) { - $db->rollback; - $log->debug("rollback"); - $log->logdie( "database error: $@" ); - } - - if (defined $vol_id and defined $vol_path) { - return 1; - } - - return; -} - -sub _create_empty_instance_file -{ - my $self = shift; - - my ($key, $so_id, $ins_id, $vol_path, $xattr) = @_; - - my $log = $self->log; - my $sql = $self->sql; - my $db = $self->db; - - my $uri; - eval { - my $storage_path = $self->_generate_storage_path($key, $vol_path); - my $storage_filename = $self->_generate_storage_filename($key, $ins_id); - unless (-d $storage_path) { - mkpath($storage_path) - or die "can't create storage path: $storage_path"; - } - my $fqpn = File::Spec->catfile($storage_path, $storage_filename); - $uri = URI::file->new($fqpn); - $log->debug("generated uri $uri"); - $self->_create_empty_file($uri->file); - }; - if ($@) { - $log->logdie($@); - } - - if ($xattr) { - my $path = $uri->file; - die "can not set xattr on $path: $!" - unless (setfattr($path, 'user.nebulous_key', $key)); - } - - return $uri; -} - - -sub _create_empty_file -{ - my $self = shift; - - my ($path) = @_; - - # perl's open() can't do an O_CREAT | O_EXCL - die "file $path already exists" if (-e $path); - - my $fh; - die "can not open $path: $!" - unless (open($fh, '>', $path)); - - die "can not close $path: $!" - unless (close($fh)); - - die "can not chmod $path: $!" - unless (chmod 0664, $path); - - return $path; -} - - -sub _generate_storage_filename -{ - my $self = shift; - - my ($key, $ins_id) = @_; - - my $filename = $key; - # mangle '/'s into ':' - $filename =~ s|/|:|g; - - return "$ins_id.$filename" -} - - -sub _generate_storage_path -{ - my $self = shift; - - my ($key, $vol_path) = @_; - - # taken and modified from Cache::File::cache_file_path() - # Copyright (C) 2003-2006 Chris Leishman. All Rights Reserved. - my $shakey = sha1_hex($key); - my (@path) = unpack('A2' x SUBPATH_DEPTH, $shakey); - - return File::Spec->catdir($vol_path, @path); -} - - -sub DESTROY -{ - my $self = shift; - - my $log = $self->log; - my $sql = $self->sql; - my $db =$self->db; - - $log->debug( "entered" ); - - $self->db->disconnect; - - $log->debug( "disconnected from database: ", sub { $db->data_sources; } ); - - $log->debug( "leaving" ); -} - -1; - -__END__ Index: trunk/Nebulous/lib/Nebulous/Server.pod =================================================================== --- trunk/Nebulous/lib/Nebulous/Server.pod (revision 16566) +++ (revision ) @@ -1,141 +1,0 @@ -=pod - -=head1 NAME - -Nebulous::Server - Nebulous server component - -=head1 SYNOPSIS - - use Nebulous::Server; - - Nebulous::Server->new( $dsn, $username, $passwd ); - Nebulous::Server->db( $db ); - Nebulous::Server->log( $log ); - Nebulous::Server->sql( $sql ); - Nebulous::Server->config( $config ); - Nebulous::Server->create_object( $key, $volume ); - Nebulous::Server->rename_object( $key, $newkey ); - Nebulous::Server->replicate_object( $key, $volume ); - Nebulous::Server->lock_object( $key, $type ); - Nebulous::Server->unlock_object( $key, $type ); - Nebulous::Server->setxattr_object( $key, $name, $value, $flags ); - Nebulous::Server->getxattr_object( $key, $name ); - Nebulous::Server->listxattr_object( $key ); - Nebulous::Server->removexattr_object( $key ); - Nebulous::Server->find_objects( $pattern ); - Nebulous::Server->find_instances( $key, $volume ); - Nebulous::Server->delete_instance( $uri ); - Nebulous::Server->stat_object( $key ); - -=head1 DESCRIPTION - -This is the server side component of the Nebulous system. It is primarily a -middle-ware abstraction of an SQL database. - -=head1 USAGE - -Typically, this module would not be directly interacted with (although, it is -possible to do so). It is intended that one or more intermediate transport -layers are used (SOAP, XML-RPC, etc.) - -=head2 Import Parameters - -This module accepts no arguments to it's C method and exports no -I. - -=head2 Methods - -=head3 Class Methods - -=over 4 - -=item * setup( $dsn, $username, $passwd ); - -Accepts 3 parameters, all are mandatory. Returns Boolean true. Throws an -exception on error. - -=item * create_object( $key, $volume ); - -Accepts 4 parameters, only the first is mandatory. Returns a URI. Throws an -exception on error. - -=item * replicate_object( $key, $volume ); - -Accepts 2 parameters, only the first is mandatory. Returns a URI. Throws an -exception on error. - -=item * lock_object( $key, $type ); - -Accepts 2 parameters, all are mandatory. Returns Boolean true. Throws an -exception on error. - -=item * unlock_object( $key, $type ); - -Accepts 2 parameters, all are mandatory. Returns Boolean true. Throws an -exception on error. - -=item * find_instance( $key, $volume ); - -Accepts 2 parameters, only the first is mandatory. Returns an arrayref. -Throws an exception on error. - -=item * delete_instance( $uri ); - -Accepts 1 parameters, it is mandatory. Returns Boolean true. Throws an -exception on error. - -=item * stat_object( $key ); - -Accepts 1 parameters, it is mandatory. Returns a list of: - - so_id - ext_id - read_lock - write_lock - epoch - mtime - number of instances - -=back - -=head1 DEVELOPER NOTES - -=head2 REFERENCES - -=head1 CREDITS - -Just me, myself, and I. - -=head1 SUPPORT - -Please contact the author directly via e-mail. - -=head1 AUTHOR - -Joshua Hoblitt - -=head1 COPYRIGHT - -Copyright (C) 2004-2005 Joshua Hoblitt. All rights reserved. - -This program is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public License as published by the Free Software -Foundation; either version 2 of the License, or (at your option) any later -version. - -This program is distributed in the hope that it will be useful, but WITHOUT ANY -WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A -PARTICULAR PURPOSE. See the GNU General Public License for more details. - -You should have received a copy of the GNU General Public License along with -this program; if not, write to the Free Software Foundation, Inc., 59 Temple -Place - Suite 330, Boston, MA 02111-1307, USA. - -The full text of the license can be found in the LICENSE file included with -this module, or in the L Pod as supplied with Perl 5.8.1 and later. - -=head1 SEE ALSO - -L - -=cut Index: trunk/Nebulous/lib/Nebulous/Util.pm =================================================================== --- trunk/Nebulous/lib/Nebulous/Util.pm (revision 16566) +++ trunk/Nebulous/lib/Nebulous/Util.pm (revision 17073) @@ -1,5 +1,5 @@ # Copyright (c) 2004 Joshua Hoblitt # -# $Id: Util.pm,v 1.10 2008-02-07 22:18:51 jhoblitt Exp $ +# $Id: Util.pm,v 1.11 2008-03-20 23:21:58 jhoblitt Exp $ package Nebulous::Util; @@ -80,49 +80,4 @@ } -sub parse_neb_key -{ - my $text = shift; - return unless defined $text; - - # white space is not allowed - if ($text =~ qr/\s+/) { - die "keys and URIs may not contain whitespace"; - } - - my $uri = URI->new($text); - my $scheme = $uri->scheme; - my $path = $uri->opaque; - - my $volume; - # if this is a valid uri - if (defined $scheme) { - # if so, does it use the neb scheme? - die "URI does not use the 'neb' scheme" - unless $scheme eq 'neb'; - - # neb:path (not allowed) - # neb:///... - # neb:/path... (leading '/' is stripped) - # neb:///path... (same as neb:/path) - - # volume specifier must be at least one character - # strip off volume component if it exists - $path =~ s|^//([^/]+)||; - $volume = $1; - - # require a leading slash if there is no volume name - if ((not defined $volume) and (not $path =~ m|^/|)) { - die "neb URI scheme requires a leading slash, eg. neb:/"; - } - } - - # strip leading slashes - $path =~ s|^/+||; - - # remove multiple /'s and trailing slashes - $path = canonpath($path); - - return ($volume, $path); -} 1; Index: trunk/Nebulous/t/01_load.t =================================================================== --- trunk/Nebulous/t/01_load.t (revision 16566) +++ trunk/Nebulous/t/01_load.t (revision 17073) @@ -3,5 +3,5 @@ # Copryight (C) 2004-2005 Joshua Hoblitt # -# $Id: 01_load.t,v 1.7 2005-06-30 02:35:06 jhoblitt Exp $ +# $Id: 01_load.t,v 1.8 2008-03-20 23:21:58 jhoblitt Exp $ use strict; @@ -10,5 +10,5 @@ use lib qw( ./t ./lib ); -use Test::More tests => 8; +use Test::More tests => 4; BEGIN { use_ok( 'Nebulous::Client' ); } @@ -16,6 +16,2 @@ BEGIN { use_ok( 'Nebulous::Client::HTTP' ); } BEGIN { use_ok( 'Nebulous::Util' ); } -BEGIN { use_ok( 'Nebulous::Server' ); } -BEGIN { use_ok( 'Nebulous::Server::SQL' ); } -BEGIN { use_ok( 'Nebulous::Server::Log' ); } -BEGIN { use_ok( 'Nebulous::Server::SOAP' ); } Index: trunk/Nebulous/t/02_server_setup.t =================================================================== --- trunk/Nebulous/t/02_server_setup.t (revision 16566) +++ (revision ) @@ -1,39 +1,0 @@ -#!/usr/bin/perl - -# Copryight (C) 2004-2005 Joshua Hoblitt -# -# $Id: 02_server_setup.t,v 1.6 2008-02-02 01:51:29 jhoblitt Exp $ - -use strict; -use warnings; - -use Test::More tests => 2; - -use lib qw( ./t ./lib ); - -use Nebulous::Server; -use Test::Nebulous; - -Test::Nebulous->setup; - -isa_ok( - Nebulous::Server->new( - dsn => $NEB_DB, - dbuser => $NEB_USER, - dbpasswd => $NEB_PASS, - ), - "Nebulous::Server" -); - -Test::Nebulous->setup; - -eval { - Nebulous::Server->new( - dsn => "DBI:mysql:database=foobar:host=localhost", - dbuser => "baz", - dbpasswd =>"boo", - ); -}; -like( $@, qr/DBI connect.*? failed/, "bad dsn/user/pass" ); - -Test::Nebulous->cleanup; Index: trunk/Nebulous/t/03_server_create_object.t =================================================================== --- trunk/Nebulous/t/03_server_create_object.t (revision 16566) +++ (revision ) @@ -1,352 +1,0 @@ -#!/usr/bin/perl - -# Copryight (C) 2004-2005 Joshua Hoblitt -# -# $Id: 03_server_create_object.t,v 1.24 2008-02-02 01:51:29 jhoblitt Exp $ - -use strict; -use warnings FATAL => qw( all ); - -use Test::More tests => 67; - -use lib qw( ./t ./lib ); - -use File::ExtAttr qw( getfattr ); -use Nebulous::Server; -use Nebulous::Util qw( :standard ); -use Test::Nebulous; -use Test::URI; -use URI::Split qw( uri_split ); - -my $test_xattr = undef; - -my $neb = Nebulous::Server->new( - dsn => $NEB_DB, - dbuser => $NEB_USER, - dbpasswd => $NEB_PASS, -); - -Test::Nebulous->setup; - -{ - # key - my $uri = $neb->create_object("foo"); - - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri); - ok(-e $path, "file exists"); - ok($neb->find_instances("foo"), 'object key exists'); - uri_scheme_ok($uri, 'file'); - -SKIP: { - skip "requires xattr support", 1 unless $test_xattr; - is(getfattr($path, 'user.nebulous_key'), 'foo', 'user.nebulous_key xattr'); -} -} - -Test::Nebulous->setup; - -{ - # key - my $uri = $neb->create_object("neb:/foo"); - - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri); - ok(-e $path, "file exists"); - ok($neb->find_instances("foo"), 'object key exists'); - uri_scheme_ok($uri, 'file'); - -SKIP: { - skip "requires xattr support", 1 unless $test_xattr; - is(getfattr($path, 'user.nebulous_key'), 'foo', 'user.nebulous_key xattr'); -} -} - -Test::Nebulous->setup; - -{ - # key - my $uri = $neb->create_object("neb://node01/foo"); - - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri); - ok(-e $path, "file exists"); - ok($neb->find_instances("foo"), 'object key exists'); - uri_scheme_ok($uri, 'file'); - -SKIP: { - skip "requires xattr support", 1 unless $test_xattr; - is(getfattr($path, 'user.nebulous_key'), 'foo', 'user.nebulous_key xattr'); -} -} - -Test::Nebulous->setup; - -{ - # key - my $uri = $neb->create_object("neb://node02/foo"); - - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri); - ok(-e $path, "file exists"); - ok($neb->find_instances("foo"), 'object key exists'); - uri_scheme_ok($uri, 'file'); - -SKIP: { - skip "requires xattr support", 1 unless $test_xattr; - is(getfattr($path, 'user.nebulous_key'), 'foo', 'user.nebulous_key xattr'); -} -} - -Test::Nebulous->setup; - -{ - # key - my $uri = $neb->create_object("/foo"); - - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri); - ok(-e $path, "file exists"); - ok($neb->find_instances("foo"), 'object key exists'); - uri_scheme_ok($uri, 'file'); - -SKIP: { - skip "requires xattr support", 1 unless $test_xattr; - is(getfattr($path, 'user.nebulous_key'), '/foo', 'user.nebulous_key xattr'); -} -} - -Test::Nebulous->setup; -{ - # key - my $uri = $neb->create_object("neb:///foo"); - - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri); - ok(-e $path, "file exists"); - ok($neb->find_instances("foo"), 'object key exists'); - uri_scheme_ok($uri, 'file'); - -SKIP: { - skip "requires xattr support", 1 unless $test_xattr; - is(getfattr($path, 'user.nebulous_key'), 'foo', 'user.nebulous_key xattr'); -} -} - -Test::Nebulous->setup; - -{ - # key - my $uri = $neb->create_object("/foo/"); - - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri); - ok(-e $path, "file exists"); - ok($neb->find_instances("foo"), 'object key exists'); - uri_scheme_ok($uri, 'file'); - -SKIP: { - skip "requires xattr support", 1 unless $test_xattr; - is(getfattr($path, 'user.nebulous_key'), '/foo/', 'user.nebulous_key xattr'); -} -} - -Test::Nebulous->setup; - -{ - # key - my $uri = $neb->create_object("neb:/foo/"); - - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri); - ok(-e $path, "file exists"); - ok($neb->find_instances("foo"), 'object key exists'); - uri_scheme_ok($uri, 'file'); - -SKIP: { - skip "requires xattr support", 1 unless $test_xattr; - is(getfattr($path, 'user.nebulous_key'), '/foo/', 'user.nebulous_key xattr'); -} -} - -Test::Nebulous->setup; - -{ - # key - my $uri = $neb->create_object("foo/"); - - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri); - ok(-e $path, "file exists"); - ok($neb->find_instances("foo"), 'object key exists'); - uri_scheme_ok($uri, 'file'); - -SKIP: { - skip "requires xattr support", 1 unless $test_xattr; - is(getfattr($path, 'user.nebulous_key'), 'foo/', 'user.nebulous_key xattr'); -} -} - -Test::Nebulous->setup; - -{ - # key - my $uri = $neb->create_object("foo/bar"); - - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri); - ok(-e $path, "file exists"); - ok($neb->find_instances("foo/bar"), 'object key exists'); - uri_scheme_ok($uri, 'file'); - -SKIP: { - skip "requires xattr support", 1 unless $test_xattr; - is(getfattr($path, 'user.nebulous_key'), 'foo/bar', 'user.nebulous_key xattr'); -} -} - -Test::Nebulous->setup; - -{ - # key - my $uri = $neb->create_object("/foo/bar"); - - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri); - ok(-e $path, "file exists"); - ok($neb->find_instances("foo/bar"), 'object key exists'); - uri_scheme_ok($uri, 'file'); - -SKIP: { - skip "requires xattr support", 1 unless $test_xattr; - is(getfattr($path, 'user.nebulous_key'), '/foo/bar', 'user.nebulous_key xattr'); -} -} - -Test::Nebulous->setup; - -{ - # key, volume - my $uri = $neb->create_object("foo", "node01"); - - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri); - ok(-e $path, "file exists"); - ok($neb->find_instances("foo"), 'object key exists'); - uri_scheme_ok($uri, 'file'); -} - -Test::Nebulous->setup; - -{ - # volume name override - my $uri = $neb->create_object("neb://node02/foo", "node01"); - - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri); - ok(-e $path, "file exists"); - ok($neb->find_instances("foo"), 'object key exists'); - uri_scheme_ok($uri, 'file'); -} - -Test::Nebulous->setup; - -{ - # volume name override - # OK because the volume arg overrides the key's implied volume - my $uri = $neb->create_object("neb://99/foo", "node01"); - - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri); - ok(-e $path, "file exists"); - ok($neb->find_instances("foo"), 'object key exists'); - uri_scheme_ok($uri, 'file'); -} - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo"); - $neb->create_object("foo"); -}; -like($@, qr/Duplicate entry/, "object already exists"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("neb:/foo"); - $neb->create_object("neb:/foo"); -}; -like($@, qr/Duplicate entry/, "object already exists"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo", 'node03'); -}; -like($@, qr/node03 is not available/, "request volume this is full"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("neb://node03/foo"); -}; -like($@, qr/node03 is not available/, "request volume this is full"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo", 'node04'); -}; -like($@, qr/node04 is not available/, "request volume with allocate = FALSE, available = FALSE"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("neb://node04/foo"); -}; -like($@, qr/node04 is not available/, "request volume with allocate = FALSE, available = FALSE"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo", 'node05'); -}; -like($@, qr/node05 is not available/, "request volume with allocate = FALSE , available = TRUE"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("neb://node05/foo"); -}; -like($@, qr/node05 is not available/, "request volume with allocate = FALSE , available = TRUE"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo", 'node06'); -}; -like($@, qr/node06 is not available/, "request volume with allocate = TRUE, available = FALSE"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("neb://node06/foo"); -}; -like($@, qr/node06 is not available/, "request volume with allocate = TRUE, available = FALSE"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo", 99); -}; -like($@, qr/did not pass the \'is valid volume name\'/, "volume name doesn't exist"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("neb://99/foo"); -}; -like($@, qr/is not a valid volume name/, "volume name doesn't exist"); - -Test::Nebulous->setup; - -eval { - $neb->create_object(); -}; -like($@, qr/1 - 2 were expected/, "no params"); - -Test::Nebulous->setup; - -eval { - $neb->create_object(1, "node01", 3); -}; -like($@, qr/1 - 2 were expected/, "too many params"); - -Test::Nebulous->cleanup; Index: trunk/Nebulous/t/04_server_replicate_object.t =================================================================== --- trunk/Nebulous/t/04_server_replicate_object.t (revision 16566) +++ (revision ) @@ -1,124 +1,0 @@ -#!/usr/bin/perl - -# Copryight (C) 2004-2005 Joshua Hoblitt -# -# $Id: 04_server_replicate_object.t,v 1.11 2008-02-02 01:51:29 jhoblitt Exp $ - -use strict; -use warnings FATAL => qw( all ); - -use Test::More tests => 16; - -use lib qw( ./t ./lib ); - -use File::ExtAttr qw( getfattr ); -use Nebulous::Server; -use Nebulous::Util qw( :standard ); -use Test::Nebulous; -use Test::URI; -use URI::Split qw( uri_split ); - -my $test_xattr = undef; - -my $neb = Nebulous::Server->new( - dsn => $NEB_DB, - dbuser => $NEB_USER, - dbpasswd => $NEB_PASS, -); - -Test::Nebulous->setup; - -{ - # key - $neb->create_object("foo"); - my $uri = $neb->replicate_object("foo"); - - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri); - ok(-e $path, "file exists"); - uri_scheme_ok($uri, 'file'); - -SKIP: { - skip "requires xattr support", 1 unless $test_xattr; - is(getfattr($path, 'user.nebulous_key'), 'foo', 'user.nebulous_key xattr'); -} -} - -Test::Nebulous->setup; - -{ - # key, $volume - $neb->create_object("foo"); - my $uri = $neb->replicate_object("foo", "node01"); - - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri); - ok(-e $path, "file exists"); - uri_scheme_ok($uri, 'file'); - -SKIP: { - skip "requires xattr support", 1 unless $test_xattr; - is(getfattr($path, 'user.nebulous_key'), 'foo', 'user.nebulous_key xattr'); -} -} - -Test::Nebulous->setup; - -{ - # key, $volume - $neb->create_object("foo"); - my $uri1 = $neb->replicate_object("foo", "node01"); - my $uri2 = $neb->replicate_object("foo", "node02"); - - { - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri1); - ok(-e $path, "file exists"); - uri_scheme_ok($uri1, 'file'); - -SKIP: { - skip "requires xattr support", 1 unless $test_xattr; - is(getfattr($path, 'user.nebulous_key'), 'foo', 'user.nebulous_key xattr'); -} - } - - { - my ($scheme, $auth, $path, $query, $frag) = uri_split($uri2); - ok(-e $path, "file exists"); - uri_scheme_ok($uri2, 'file'); - -SKIP: { - skip "requires xattr support", 1 unless $test_xattr; - is(getfattr($path, 'user.nebulous_key'), 'foo', 'user.nebulous_key xattr'); -} - } -} - -Test::Nebulous->setup; - -eval { - $neb->replicate_object('foo'); -}; -like($@, qr/is valid object key/, 'storage object does not exist'); - -Test::Nebulous->setup; - -eval { - $neb->create_object('foo'); - $neb->replicate_object('foo', 'bar'); -}; -like($@, qr/is valid volume name/, 'storage volume does not exist'); - -Test::Nebulous->setup; - -eval { - $neb->replicate_object(); -}; -like($@, qr/1 - 2 were expected/, 'no params'); - -Test::Nebulous->setup; - -eval { - $neb->create_object('foo'); - $neb->replicate_object('foo', 'node01', 3); -}; -like($@, qr/1 - 2 were expected/, 'too many params'); - -Test::Nebulous->cleanup; Index: trunk/Nebulous/t/05_server_lock_object.t =================================================================== --- trunk/Nebulous/t/05_server_lock_object.t (revision 16566) +++ (revision ) @@ -1,127 +1,0 @@ -#!/usr/bin/perl - -# Copryight (C) 2004-2005 Joshua Hoblitt -# -# $Id: 05_server_lock_object.t,v 1.9 2008-02-02 01:51:29 jhoblitt Exp $ - -use strict; -use warnings FATAL => qw( all ); - -use Test::More tests => 13; - -use lib qw( ./t ./lib ); - -use Nebulous::Server; -use Nebulous::Util qw( :standard ); -use Test::Nebulous; - -my $neb = Nebulous::Server->new( - dsn => $NEB_DB, - dbuser => $NEB_USER, - dbpasswd => $NEB_PASS, -); - -Test::Nebulous->setup; - -{ - $neb->create_object("foo"); - - ok($neb->lock_object("foo", "read"), "read lock"); -} - -Test::Nebulous->setup; - -{ - $neb->create_object("foo"); - - ok($neb->lock_object("foo", "read"), "read lock"); - ok($neb->lock_object("foo", "read"), "read lock"); -} - -Test::Nebulous->setup; - -{ - $neb->create_object("foo"); - - ok($neb->lock_object("foo", "write"), "write lock"); -} - -Test::Nebulous->setup; - -eval { - $neb->lock_object("foo", "read"); -}; -like($@, qr/is valid object key/, "storage object does not exist"); - -Test::Nebulous->setup; - -eval { - $neb->lock_object("foo", "write"); -}; -like($@, qr/is valid object key/, "storage object does not exist"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo"); - - $neb->lock_object("foo", "write"); - $neb->lock_object("foo", "write"); -}; -like($@, qr/can not write lock twice/, "can not write lock twice"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo"); - - $neb->lock_object("foo", "read"); - $neb->lock_object("foo", "write"); -}; -like($@, qr/can not write lock after read lock/, "can not write lock after read lock"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo"); - - $neb->lock_object("foo", "write"); - $neb->lock_object("foo", "read"); -}; -like($@, qr/can not read lock after write lock/, "can not read lock after write lock"); - -Test::Nebulous->setup; - -eval { - $neb->lock_object(); -}; -like($@, qr/2 were expected/, "no params"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo"); - - $neb->lock_object("foo"); -}; -like($@, qr/2 were expected/, "not enough params"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo"); - - $neb->lock_object("foo", "both"); -}; -like($@, qr/is read or write/, "not read or write"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo"); - - $neb->lock_object("foo", 'read', 3); -}; -like($@, qr/2 were expected/, "too many params"); - -Test::Nebulous->cleanup; Index: trunk/Nebulous/t/06_server_unlock_object.t =================================================================== --- trunk/Nebulous/t/06_server_unlock_object.t (revision 16566) +++ (revision ) @@ -1,142 +1,0 @@ -#!/usr/bin/perl - -# Copryight (C) 2004-2005 Joshua Hoblitt -# -# $Id: 06_server_unlock_object.t,v 1.9 2008-02-02 01:51:29 jhoblitt Exp $ - -use strict; -use warnings FATAL => qw( all ); - -use Test::More tests => 14; - -use lib qw( ./t ./lib ); - -use Nebulous::Server; -use Nebulous::Util qw( :standard ); -use Test::Nebulous; - -my $neb = Nebulous::Server->new( - dsn => $NEB_DB, - dbuser => $NEB_USER, - dbpasswd => $NEB_PASS, -); - -Test::Nebulous->setup; - -{ - $neb->create_object("foo"); - - $neb->lock_object("foo", "read"); - - ok($neb->unlock_object("foo", "read"), "read unlock"); -} - -Test::Nebulous->setup; - -{ - $neb->create_object("foo"); - - $neb->lock_object("foo", "read"); - $neb->lock_object("foo", "read"); - - ok($neb->unlock_object("foo", "read"), "read unlock"); - ok($neb->unlock_object("foo", "read"), "read unlock"); -} - -Test::Nebulous->setup; - -{ - $neb->create_object("foo"); - - $neb->lock_object("foo", "write"); - - ok($neb->unlock_object("foo", "write"), "write unlock"); -} - -Test::Nebulous->setup; - -eval { - $neb->unlock_object("foo", "read"); -}; -like($@, qr/is valid object key/, "storage object does not exist"); - -Test::Nebulous->setup; - -eval { - $neb->unlock_object("foo", "write"); -}; -like($@, qr/is valid object key/, "storage object does not exist"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo"); - - $neb->unlock_object("foo", "read"); -}; -like($@, qr/can not remove non-existant read lock/, "no lock set"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo"); - - $neb->unlock_object("foo", "write"); -}; -like($@, qr/can not remove non-existant write lock/, "no lock set"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo"); - $neb->lock_object("foo", "write"); - - $neb->unlock_object("foo", "read"); -}; -like($@, qr/can not have a read lock under a write lock/, "read unlock under write lock"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo"); - $neb->lock_object("foo", "read"); - - $neb->unlock_object("foo", "write"); -}; -like($@, qr/can not have a write lock under a read lock/, "write unlock under read lock"); - -Test::Nebulous->setup; - -eval { - $neb->unlock_object(); -}; -like($@, qr/2 were expected/, "no params"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo"); - - $neb->unlock_object("foo"); -}; -like($@, qr/2 were expected/, "not enough params"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo"); - - $neb->unlock_object("foo", "both"); -}; -like($@, qr/is read or write/, "not read or write"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo"); - - $neb->unlock_object("foo", 'read', 3); -}; -like($@, qr/2 were expected/, "too many params"); - -Test::Nebulous->cleanup; Index: trunk/Nebulous/t/07_server_find_instances.t =================================================================== --- trunk/Nebulous/t/07_server_find_instances.t (revision 16566) +++ (revision ) @@ -1,119 +1,0 @@ -#!/usr/bin/perl - -# Copryight (C) 2004-2005 Joshua Hoblitt -# -# $Id: 07_server_find_instances.t,v 1.9 2008-02-02 01:51:29 jhoblitt Exp $ - -use strict; -use warnings FATAL => qw( all ); - -use Test::More tests => 15; - -use lib qw( ./t ./lib ); - -use Nebulous::Server; -use Nebulous::Util qw( :standard ); -use Test::URI; -use Test::Nebulous; - -my $neb = Nebulous::Server->new( - dsn => $NEB_DB, - dbuser => $NEB_USER, - dbpasswd => $NEB_PASS, -); - -Test::Nebulous->setup; - -{ - # key - my $uri = $neb->create_object("foo"); - - my $locations = $neb->find_instances("foo"); - - uri_scheme_ok($locations->[0], 'file'); - is($uri, $locations->[0], "URIs match"); -} - -Test::Nebulous->setup; - -{ - # key - my $uri1 = $neb->create_object("foo"); - my $uri2 = $neb->replicate_object("foo"); - - my $locations = $neb->find_instances("foo"); - - uri_scheme_ok($locations->[0], 'file'); - uri_scheme_ok($locations->[1], 'file'); - ok(eq_set([$uri1, $uri2], $locations), "URIs match"); -} - -Test::Nebulous->setup; - -{ - # key, volume - my $uri = $neb->create_object('foo', 'node01'); - - my $locations = $neb->find_instances('foo', 'node01'); - - uri_scheme_ok($locations->[0], 'file'); - is($uri, $locations->[0], "URIs match"); -} - -Test::Nebulous->setup; - -{ - # key - my $uri1 = $neb->create_object("foo"); - my $uri2 = $neb->replicate_object("foo"); - - my $locations = $neb->find_instances("foo", "node01"); - - uri_scheme_ok($locations->[0], 'file'); - uri_scheme_ok($locations->[1], 'file'); - ok(eq_set([$uri1, $uri2], $locations), "URIs match"); -} - -# object exists but instance is on a different volume -Test::Nebulous->setup; - -eval { - # key, volume - my $uri = $neb->create_object('foo', 'node01'); - - my $locations = $neb->find_instances('foo', 'node02'); -}; -like($@, qr/no instances on storage volume/, 'instances on a different volume'); - - -Test::Nebulous->setup; - -eval { - $neb->find_instances('foo'); -}; -like($@, qr/is valid object key/, "storage object does not exist"); - -Test::Nebulous->setup; - -eval { - $neb->create_object('foo'); - $neb->find_instances('foo', 'bar'); -}; -like($@, qr/is valid volume name/, "storage volume does not exist"); - -Test::Nebulous->setup; - -eval { - $neb->find_instances(); -}; -like($@, qr/1 - 2 were expected/, "no params"); - -Test::Nebulous->setup; - -eval { - $neb->create_object('foo'); - $neb->find_instances('foo', 'node01', 3); -}; -like($@, qr/1 - 2 were expected/, "too many params"); - -Test::Nebulous->cleanup; Index: trunk/Nebulous/t/08_server_delete_instance.t =================================================================== --- trunk/Nebulous/t/08_server_delete_instance.t (revision 16566) +++ (revision ) @@ -1,73 +1,0 @@ -#!/usr/bin/perl - -# Copryight (C) 2004-2005 Joshua Hoblitt -# -# $Id: 08_server_delete_instance.t,v 1.9 2008-02-02 01:51:29 jhoblitt Exp $ - -use strict; -use warnings FATAL => qw( all ); - -use Test::More tests => 8; - -use lib qw( ./t ./lib ); - -use Nebulous::Server; -use Nebulous::Util qw( :standard ); -use Test::Nebulous; - -my $neb = Nebulous::Server->new( - dsn => $NEB_DB, - dbuser => $NEB_USER, - dbpasswd => $NEB_PASS, -); - -Test::Nebulous->setup; - -{ - my $uri = $neb->create_object("foo"); - - ok($neb->delete_instance($uri), "delete instance"); -} - -Test::Nebulous->setup; - -{ - my $uri1 = $neb->create_object("foo"); - my $uri2 = $neb->replicate_object("foo"); - - ok($neb->delete_instance($uri1), "delete instance"); - - my $locations = $neb->find_instances("foo"); - - is($locations->[0], $uri2, "instance remains"); - - ok($neb->delete_instance( $uri2 ), "delete instance"); - - eval { - $neb->find_instances("foo"); - }; - like($@, qr/is valid object key/, "storage object was deleted"); -} - -Test::Nebulous->setup; - -eval { - $neb->delete_instance("file:/foo"); -}; -like($@, qr/no instance is associated with uri/, "uri does not exist"); - -Test::Nebulous->setup; - -eval { - $neb->delete_instance(); -}; -like($@, qr/1 was expected/, "no params"); - -Test::Nebulous->setup; - -eval { - $neb->delete_instance("foo", 2); -}; -like($@, qr/1 was expected/, "too many params"); - -Test::Nebulous->cleanup; Index: trunk/Nebulous/t/09_server_stat_object.t =================================================================== --- trunk/Nebulous/t/09_server_stat_object.t (revision 16566) +++ (revision ) @@ -1,72 +1,0 @@ -#!/usr/bin/perl - -# Copryight (C) 2004-2005 Joshua Hoblitt -# -# $Id: 09_server_stat_object.t,v 1.12 2008-02-02 01:51:29 jhoblitt Exp $ - -use strict; -use warnings FATAL => qw( all ); - -use Test::More tests => 12; - -use lib qw( ./t ./lib ); - -use Nebulous::Server; -use Nebulous::Util qw( :standard ); -use Test::Nebulous; - -my $neb = Nebulous::Server->new( - dsn => $NEB_DB, - dbuser => $NEB_USER, - dbpasswd => $NEB_PASS, -); - -Test::Nebulous->setup; -{ - $neb->create_object("foo"); - - my $info = $neb->stat_object("foo"); - - is(scalar @$info, 7, "number of columns"); -} - -Test::Nebulous->setup; - -{ - $neb->create_object("foo", "node01"); - - my $info = $neb->stat_object("foo"); - - is(scalar @$info, 7, "number of columns"); - is(@$info[0], 1, "so_id"); - is(@$info[1], "foo", "ext_id"); - is(@$info[2], 0, "read lock"); - is(@$info[3], undef, "write lock"); - like(@$info[4], qr/....-..-.. ..:..:../, "epoch"); - like(@$info[5], qr/....-..-.. ..:..:../, "mtime"); - is(@$info[6], 1, "instances"); -} - -Test::Nebulous->setup; - -eval { - $neb->stat_object("foo"); -}; -like($@, qr/is valid object key/, "object does not exist"); - -Test::Nebulous->setup; - -eval { - $neb->stat_object(); -}; -like($@, qr/1 was expected/, "no params"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo"); - $neb->stat_object("foo", 2); -}; -like($@, qr/1 was expected/, "too many params"); - -Test::Nebulous->cleanup; Index: trunk/Nebulous/t/10_server_is_valid_volume_name.t =================================================================== --- trunk/Nebulous/t/10_server_is_valid_volume_name.t (revision 16566) +++ (revision ) @@ -1,36 +1,0 @@ -#!/usr/bin/perl - -# Copryight (C) 2004-2005 Joshua Hoblitt -# -# $Id: 10_server_is_valid_volume_name.t,v 1.4 2008-02-02 01:51:29 jhoblitt Exp $ - -use strict; -use warnings FATAL => qw( all ); - -use Test::More tests => 3; - -use lib qw( ./t ./lib ); - -use Nebulous::Server; -use Nebulous::Util qw( :standard ); -use Test::Nebulous; - -my $neb = Nebulous::Server->new( - dsn => $NEB_DB, - dbuser => $NEB_USER, - dbpasswd => $NEB_PASS, -); - -Test::Nebulous->setup; - -ok($neb->_is_valid_volume_name('node01'), "valid volume name"); - -Test::Nebulous->setup; - -ok($neb->_is_valid_volume_name('node02'), "valid volume name"); - -Test::Nebulous->setup; - -is($neb->_is_valid_volume_name('node99'), undef, "invalid volume name"); - -Test::Nebulous->cleanup; Index: trunk/Nebulous/t/11_server_is_valid_object_key.t =================================================================== --- trunk/Nebulous/t/11_server_is_valid_object_key.t (revision 16566) +++ (revision ) @@ -1,38 +1,0 @@ -#!/usr/bin/perl - -# Copryight (C) 2004-2005 Joshua Hoblitt -# -# $Id: 11_server_is_valid_object_key.t,v 1.2 2008-02-02 01:51:29 jhoblitt Exp $ - -use strict; -use warnings FATAL => qw( all ); - -use Test::More tests => 2; - -use lib qw( ./t ./lib ); - -use Nebulous::Server; -use Nebulous::Util qw( :standard ); -use Test::Nebulous; - -my $neb = Nebulous::Server->new( - dsn => $NEB_DB, - dbuser => $NEB_USER, - dbpasswd => $NEB_PASS, -); - -Test::Nebulous->setup; - -{ - $neb->create_object('foo'); - - ok($neb->_is_valid_object_key('foo'), "valid object key"); -} - -Test::Nebulous->setup; - -{ - ok(!$neb->_is_valid_object_key('foo'), "invalid object key"); -} - -Test::Nebulous->cleanup; Index: trunk/Nebulous/t/12_server_find_objects.t =================================================================== --- trunk/Nebulous/t/12_server_find_objects.t (revision 16566) +++ (revision ) @@ -1,68 +1,0 @@ -#!/usr/bin/perl - -# Copryight (C) 2004-2005 Joshua Hoblitt -# -# $Id: 12_server_find_objects.t,v 1.2 2008-02-02 01:51:29 jhoblitt Exp $ - -use strict; -use warnings FATAL => qw( all ); - -use Test::More tests => 6; - -use lib qw( ./t ./lib ); - -use Nebulous::Server; -use Nebulous::Util qw( :standard ); -use Test::Nebulous; - -my $neb = Nebulous::Server->new( - dsn => $NEB_DB, - dbuser => $NEB_USER, - dbpasswd => $NEB_PASS, -); - -Test::Nebulous->setup; - -# search for a regex of '' should match nothing -{ - # key - my $uri = $neb->create_object("foo"); - - my $keys = $neb->find_objects(); - - is(scalar @$keys, 0, 'number of keys found'); -} - -Test::Nebulous->setup; - -{ - # key - my $uri = $neb->create_object("foo"); - - my $keys = $neb->find_objects("foo"); - - is(scalar @$keys, 1, 'number of keys found'); - is($keys->[0], "foo", "key name"); -} - -Test::Nebulous->setup; - -{ - # key - my $uri1 = $neb->create_object("foo"); - my $uri2 = $neb->replicate_object("foo"); - - my $keys = $neb->find_objects("foo"); - - is(scalar @$keys, 1, 'number of keys found'); - is($keys->[0], "foo", "key name"); -} - -Test::Nebulous->setup; - -eval { - $neb->find_objects("foo", 3); -}; -like($@, qr/1 was expected/, "too many params"); - -Test::Nebulous->cleanup; Index: trunk/Nebulous/t/13_server_rename_object.t =================================================================== --- trunk/Nebulous/t/13_server_rename_object.t (revision 16566) +++ (revision ) @@ -1,73 +1,0 @@ -#!/usr/bin/perl - -# Copryight (C) 2007 Joshua Hoblitt -# -# $Id: 13_server_rename_object.t,v 1.3 2008-02-02 01:51:29 jhoblitt Exp $ - -use strict; -use warnings FATAL => qw( all ); - -use Test::More tests => 6; - -use lib qw( ./t ./lib ); - -use Nebulous::Server; -use Nebulous::Util qw( :standard ); -use Test::Nebulous; - -my $neb = Nebulous::Server->new( - dsn => $NEB_DB, - dbuser => $NEB_USER, - dbpasswd => $NEB_PASS, -); - -Test::Nebulous->setup; - -{ - my $uri = $neb->create_object("foo"); - - $neb->rename_object("foo", "bar"); - - my $keys = $neb->find_objects('^foo$'); - is(scalar @$keys, 0, 'number of keys found'); - $keys = $neb->find_objects('^bar$'); - is(scalar @$keys, 1, 'number of keys found'); -} - -Test::Nebulous->setup; - -# destination key exists -eval { - $neb->create_object('foo'); - $neb->create_object('bar'); - - $neb->rename_object('foo', 'bar'); -}; -like($@, qr/is not valid object key/, "too few params"); - -Test::Nebulous->setup; - -eval { - $neb->rename_object(); -}; -like($@, qr/2 were expected/, "no params"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo"); - - $neb->rename_object("foo"); -}; -like($@, qr/2 were expected/, "too few params"); - -Test::Nebulous->setup; - -eval { - $neb->create_object("foo"); - - $neb->rename_object("foo", "bar", "baz"); -}; -like($@, qr/2 were expected/, "too many params"); - -Test::Nebulous->cleanup; Index: trunk/Nebulous/t/14_server_xattr.t =================================================================== --- trunk/Nebulous/t/14_server_xattr.t (revision 16566) +++ (revision ) @@ -1,187 +1,0 @@ -#!/usr/bin/perl - -# Copryight (C) 2007 Joshua Hoblitt -# -# $Id: 14_server_xattr.t,v 1.3 2008-02-02 01:51:29 jhoblitt Exp $ - -use strict; -use warnings FATAL => qw( all ); - -use Test::More tests => 32; - -use lib qw( ./t ./lib ); - -use Nebulous::Server; -use Nebulous::Util qw( :standard ); -use Test::Nebulous; - -my $neb = Nebulous::Server->new( - dsn => $NEB_DB, - dbuser => $NEB_USER, - dbpasswd => $NEB_PASS, -); - -# 1 key / xattr - -Test::Nebulous->setup; - -{ - my $uri = $neb->create_object('foo'); - - ok($neb->setxattr_object('foo', 'bar', 'baz', 'create'), 'set object xattr'); - { - my @xattrs = $neb->listxattr_object('foo'); - is(scalar @xattrs, 1, 'number of xattrs'); - is($xattrs[0], 'bar', 'xattr name'); - } - - my $value = $neb->getxattr_object('foo', 'bar'); - is($value, 'baz', 'xattr value'); - - ok($neb->removexattr_object('foo', 'bar'), "remove object xattr"); - { - my @xattrs = $neb->listxattr_object('foo'); - is(scalar @xattrs, 0, 'number of xattrs'); - } -} - -# multiple xattrs - -Test::Nebulous->setup; - -{ - my $uri = $neb->create_object('foo'); - - ok($neb->setxattr_object('foo', 'bar', 'baz', 'create'), 'set object xattr'); - ok($neb->setxattr_object('foo', 'bonk', 'quix', 'create'), 'set object xattr'); - - { - my @xattrs = $neb->listxattr_object('foo'); - is(scalar @xattrs, 2, 'number of xattrs'); - is($xattrs[0], 'bar', 'xattr name'); - is($xattrs[1], 'bonk', 'xattr name'); - } - - my $value = $neb->getxattr_object('foo', 'bar'); - is($value, 'baz', 'xattr value'); - $value = $neb->getxattr_object('foo', 'bonk'); - is($value, 'quix', 'xattr value'); - - ok($neb->removexattr_object('foo', 'bar'), "remove object xattr"); - ok($neb->removexattr_object('foo', 'bonk'), "remove object xattr"); - { - my @xattrs = $neb->listxattr_object('foo'); - is(scalar @xattrs, 0, 'number of xattrs'); - } -} - -# replace xattrs - -Test::Nebulous->setup; - -{ - my $uri = $neb->create_object('foo'); - - ok($neb->setxattr_object('foo', 'bar', 'baz', 'create'), 'set object xattr'); - ok($neb->setxattr_object('foo', 'bar', 'quix', 'replace'), 're-set object xattr'); - - { - my @xattrs = $neb->listxattr_object('foo'); - is(scalar @xattrs, 1, 'number of xattrs'); - is($xattrs[0], 'bar', 'xattr name'); - } - - my $value = $neb->getxattr_object('foo', 'bar'); - is($value, 'quix', 'xattr value'); - - ok($neb->removexattr_object('foo', 'bar'), "remove object xattr"); - { - my @xattrs = $neb->listxattr_object('foo'); - is(scalar @xattrs, 0, 'number of xattrs'); - } -} - -# setxattr_object - -Test::Nebulous->setup; - -eval { - $neb->setxattr_object(); -}; -like($@, qr/4 were expected/, "no params"); - -Test::Nebulous->setup; - -eval { - $neb->create_object('foo'); - - $neb->setxattr_object('foo', 'bar'); -}; -like($@, qr/4 were expected/, "too few params"); - -Test::Nebulous->setup; - -eval { - $neb->create_object('foo'); - - $neb->setxattr_object('foo', 'bar', 'baz'); -}; -like($@, qr/4 were expected/, "too few params"); - -Test::Nebulous->setup; - -eval { - $neb->create_object('foo'); - - $neb->setxattr_object('foo', 'bar', 'baz', 'create', 'quix'); -}; -like($@, qr/4 were expected/, "too many params"); - -# listxattr_object - -Test::Nebulous->setup; - -eval { - $neb->create_object('foo'); - - $neb->listxattr_object(); -}; -like($@, qr/1 was expected/, "no params"); - -Test::Nebulous->setup; - -eval { - $neb->create_object('foo'); - - $neb->listxattr_object('foo', 'bar'); -}; -like($@, qr/1 was expected/, "too many params"); - -# getxattr_object - -Test::Nebulous->setup; - -eval { - $neb->getxattr_object(); -}; -like($@, qr/2 were expected/, "no params"); - -Test::Nebulous->setup; - -eval { - $neb->create_object('foo'); - - $neb->getxattr_object('foo'); -}; -like($@, qr/2 were expected/, "too few params"); - -Test::Nebulous->setup; - -eval { - $neb->create_object('foo'); - - $neb->getxattr_object('foo', 'bar', 'baz'); -}; -like($@, qr/2 were expected/, "too many params"); - -Test::Nebulous->cleanup; Index: trunk/Nebulous/t/Test/Nebulous.pm =================================================================== --- trunk/Nebulous/t/Test/Nebulous.pm (revision 16566) +++ (revision ) @@ -1,94 +1,0 @@ -# Copyright (C) 2004 Joshua Hoblitt -# -# $Id: Nebulous.pm,v 1.17 2008-02-07 22:17:45 jhoblitt Exp $ - -package Test::Nebulous; - -use strict; - -our $VERSION = '0.01'; - -use base qw( Exporter ); - -use DBI; -use File::Path qw( mkpath rmtree ); -use File::Temp qw( tempdir ); -use Nebulous::Server::SQL; - -our @EXPORT = qw( $NEB_DB $NEB_USER $NEB_PASS ); - -our $NEB_DB = $ENV{'NEB_DB'} || "DBI:mysql:database=test:host=localhost"; -our $NEB_USER = $ENV{'NEB_USER'} || "test"; -our $NEB_PASS = $ENV{'NEB_PASS'} || ''; - -my $dbh = DBI->connect( $NEB_DB, $NEB_USER, $NEB_PASS ); -my $sql = Nebulous::Server::SQL->new; - -# suppress uninitalized warnings -my $dir1 = ""; -my $dir2 = ""; -my $dir3 = ""; -my $dir4 = ""; -my $dir5 = ""; -my $dir6 = ""; - -sub setup { - my $self = shift; - - $self->cleanup; - - # create directories after cleanup - $dir1 = tempdir( CLEANUP => 0 ); - $dir2 = tempdir( CLEANUP => 0 ); - $dir3 = tempdir( CLEANUP => 0 ); - $dir4 = tempdir( CLEANUP => 0 ); - $dir5 = tempdir( CLEANUP => 0 ); - $dir6 = tempdir( CLEANUP => 0 ); - - foreach my $statement (@{ $sql->get_db_schema }) { - $dbh->do( $statement ); - } - - # node01/node02: allocate = TRUE - $dbh->do(qq{ INSERT INTO volume (vol_id, name, path, allocate, available) VALUES (1, 'node01', ?, TRUE, TRUE) }, undef, $dir1); - $dbh->do(qq{ INSERT INTO mount VALUES (?, 10e10, 10e7) }, undef, $dir1); - - $dbh->do(qq{ INSERT INTO volume (vol_id, name, path, allocate, available) VALUES (2, 'node02', ?, TRUE, TRUE) }, undef, $dir2); - $dbh->do(qq{ INSERT INTO mount VALUES (?, 10e10, 10e8) }, undef, $dir2); - - # node03: allocate = TRUE, volume full - $dbh->do(qq{ INSERT INTO volume (vol_id, name, path, allocate, available) VALUES (3, 'node03', ?, TRUE, TRUE) }, undef, $dir3); - $dbh->do(qq{ INSERT INTO mount VALUES (?, 10e10, 10e10) }, undef, $dir3); - - # node04: allocate = FALSE, available = FALSE - $dbh->do(qq{ INSERT INTO volume (vol_id, name, path, allocate, available) VALUES (4, 'node04', ?, FALSE, FALSE) }, undef, $dir4); - $dbh->do(qq{ INSERT INTO mount VALUES (?, 10e10, 10e7) }, undef, $dir4); - - # node05: allocate = FALSE, available = TRUE - $dbh->do(qq{ INSERT INTO volume (vol_id, name, path, allocate, available) VALUES (5, 'node05', ?, FALSE, TRUE) }, undef, $dir5); - $dbh->do(qq{ INSERT INTO mount VALUES (?, 10e10, 10e7) }, undef, $dir5); - - # node06: allocate = TRUE, available = FALSE - $dbh->do(qq{ INSERT INTO volume (vol_id, name, path, allocate, available) VALUES (6, 'node06', ?, TRUE, FALSE) }, undef, $dir4); - $dbh->do(qq{ INSERT INTO mount VALUES (?, 10e10, 10e7) }, undef, $dir6); - - $dbh->do(qq{ call getmountedvol() }); -} - -sub cleanup { - foreach my $statement (@{ $sql->get_db_clear }) { - $dbh->do( $statement ); - } - - # on the first call to setup the $dir[12] will be "" - rmtree([$dir1], 0, 1) if -e $dir1; - rmtree([$dir2], 0, 1) if -e $dir2; - rmtree([$dir3], 0, 1) if -e $dir3; - rmtree([$dir4], 0, 1) if -e $dir4; - rmtree([$dir5], 0, 1) if -e $dir5; - rmtree([$dir6], 0, 1) if -e $dir6; -} - -1; - -__END__