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;