Index: branches/cnb_branch_20081010/Nebulous/lib/Nebulous/Client.pm
===================================================================
--- trunk/Nebulous/lib/Nebulous/Client.pm	(revision 17736)
+++ branches/cnb_branch_20081010/Nebulous/lib/Nebulous/Client.pm	(revision 20043)
@@ -1,5 +1,5 @@
 # Copyright (c) 2004-2008  Joshua Hoblitt
 #
-# $Id: Client.pm,v 1.50 2008-05-16 23:37:54 jhoblitt Exp $
+# $Id: Client.pm,v 1.60 2008-09-24 00:36:56 jhoblitt Exp $
 
 package Nebulous::Client;
@@ -9,5 +9,5 @@
 no warnings qw( uninitialized );
 
-our $VERSION = '0.08';
+our $VERSION = '0.09';
 
 use Digest::MD5;
@@ -171,22 +171,8 @@
     $log->debug( "URI is: $uri" );
 
-    # XXX this is a attempt to work around some sort of nasty NFS bug where
-    # occasionally stat()/open() on a file on an NFS mounted filesystem will
-    # fail EVEN THOU THE FILE ACTUALLY EXISTS.
-    #
-    #  The instance file attempting to be opened should always exist as it was
-    #  created by the Nebulous server.
     my $fh;
-    for (my $i = 0; $i < 10; $i++) {
-        eval {
-            $fh = _open_uri( $uri, '+<' );
-        };
-        if ($@ =~ qr/file doesn't exist/) {
-            $log->set_err($@);
-            sleep 1;
-        } else {
-            last;
-        }
-    }
+    eval {
+        $fh = _open_uri( $uri, '+<' );
+    };
     $log->logdie( $@ ) if $@;
 
@@ -205,5 +191,5 @@
         {
             # volume
-            type        => SCALAR,
+            type        => SCALAR|UNDEF,
             optional    => 1,
         },
@@ -245,5 +231,9 @@
     my $success = File::Copy::copy( $fh, $new_fh );
     unless ($success) {
-        $self->delete_instance("$uri");
+        # if the copy failed we now have a zero length instances floating
+        # around that must be removed
+        unless ($self->delete_instance("$uri")) {
+            $log->logdie( "can not copy instance $uri AND FAILED TO CLEANUP EMPTY INSTANCE" );
+        }
         $log->logdie( "can not copy instance $uri" );
     } 
@@ -486,5 +476,5 @@
             type        => SCALAR,
             callbacks   => {
-                'is read or write' => sub { $_[0] =~ /^(?:create|replace)$/i },
+                'is create or replace' => sub { $_[0] =~ /^(?:create|replace)$/i },
             },
         },
@@ -635,5 +625,5 @@
         {
             #volume
-            type        => SCALAR,
+            type        => SCALAR|UNDEF,
             optional    => 1,
         },
@@ -650,4 +640,9 @@
             return;
         }
+        # key is valid but no instances are on the specified volume
+        if ($response->faultstring =~ /no instances on storage volume/) {
+            $log->debug( "leaving" );
+            return;
+        }
 
         $log->logdie("unhandled fault - ", $self->err);
@@ -666,13 +661,29 @@
     my $self = shift;
 
-    my ( $key ) = validate_pos( @_,
-        {
-            type        => SCALAR,
-        },
-    );
-
-    $log->debug( "entered - @_" );
-
-    my $locations = $self->find_instances( $key );
+    my ( $key, @params ) = validate_pos( @_,
+        {
+            type        => SCALAR,
+        },
+        {
+            #volume
+            type        => SCALAR|UNDEF,
+            optional    => 1,
+        },
+    );
+
+    $log->debug( "entered - @_" );
+
+    my $locations = $self->find_instances( $key, @params );
+    unless (defined $locations) {
+        unless ($self->err =~ /no instances on storage volume/) {
+            return;
+        }
+
+        # then fall back to looking for isntances on any volume
+        $locations = $self->find_instances( $key, 'any');
+        unless (defined $locations) {
+            return;
+        }
+    }
 
     my $path;
@@ -772,5 +783,5 @@
     $log->debug( "entered - @_" );
 
-    my $locations = $self->find_instances( $key );
+    my $locations = $self->find_instances( $key, 'any' );
 
     return undef unless $locations;
Index: branches/cnb_branch_20081010/Nebulous/lib/Nebulous/Util.pm
===================================================================
--- trunk/Nebulous/lib/Nebulous/Util.pm	(revision 17736)
+++ branches/cnb_branch_20081010/Nebulous/lib/Nebulous/Util.pm	(revision 20043)
@@ -1,5 +1,5 @@
 # Copyright (c) 2004  Joshua Hoblitt
 #
-# $Id: Util.pm,v 1.11 2008-03-20 23:21:58 jhoblitt Exp $
+# $Id: Util.pm,v 1.13 2008-07-10 23:21:27 jhoblitt Exp $
 
 package Nebulous::Util;
@@ -8,5 +8,5 @@
 use warnings FATAL => qw( all );
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 use base qw( Exporter );
@@ -24,4 +24,9 @@
     _open_uri
     parse_neb_key
+    print_xattrs
+    print_all_xattrs
+    write_xattrs
+    delete_xattrs
+    parse_xattr_pair
 );
 
@@ -39,4 +44,5 @@
 );
 
+
 sub _nuke_file {
     my $path = shift;
@@ -51,4 +57,5 @@
 }
 
+
 sub _get_file_path {
     my $uri = shift;
@@ -59,14 +66,36 @@
 }
 
+
 sub _get_filehandle {
     my ( $path, $flags ) = @_;
 
-    die "can't open file $path: file doesn't exist" 
-        unless -e $path;
-    CORE::open( my $fh, $flags, $path )
-        or die "can't open file $path: $!";
-
+    # XXX this is a attempt to work around some sort of nasty NFS bug where
+    # occasionally stat()/open() on a file on an NFS mounted filesystem will
+    # fail EVEN THOU THE FILE ACTUALLY EXISTS.
+    #
+    # The instance file attempting to be opened should always exist as it was
+    # created by the Nebulous server.
+    my $fh;
+    for (my $i = 0; $i < 60; $i++) {
+        eval {
+            die "can't open file $path: file doesn't exist" 
+                unless -e $path;
+            CORE::open($fh, $flags, $path)
+                or die "can't open file $path: $!";
+        };
+        if ($@ =~ qr/file doesn't exist/) {
+            sleep 1;
+            next;
+        } 
+        if ($@) {
+            die $@;
+        }
+
+        last;
+    }
+    
     return $fh;
 }
+
 
 sub _open_uri {
@@ -81,4 +110,96 @@
 
 
+sub print_all_xattrs
+{
+    my ($neb, $key) = @_;
+
+    return unless defined $neb;
+    return unless defined $key;
+
+    my $xattr_names = $neb->listxattr($key) or die $neb->err;
+    foreach my $name (@$xattr_names) {
+        print_xattrs($neb, $key, $name) or return;
+    }
+
+    return 1;
+}
+
+
+sub print_xattrs
+{
+    my ($neb, $key, @xattr_names) = @_;
+
+    return unless defined $neb;
+    return unless defined $key;
+    return unless scalar @xattr_names;
+
+    foreach my $arg (@xattr_names) {
+        my ($name, $value) = parse_xattr_pair($arg);
+        die "can not process $arg because it is in name:value form"
+            if defined $value;
+        $value = $neb->getxattr($key, $name) or die $neb->err;
+        print "$name:$value\n";
+    }
+
+    return 1;
+}
+
+
+sub write_xattrs
+{
+    my ($neb, $key, @xattr_pairs) = @_;
+
+    return unless defined $neb;
+    return unless defined $key;
+    return unless scalar @xattr_pairs;
+
+    foreach my $arg (@xattr_pairs) {
+        my ($name, $value) = parse_xattr_pair($arg);
+        die "can not process $arg because it is not in name:value form"
+            unless defined $name and defined $value;
+        die "xattr name: $name is not in to the form user.name"
+            unless $name =~ /^user\./;
+        $neb->setxattr($key, $name, $value, "replace")
+            or die $neb->err;
+    }
+
+    return 1;
+}
+
+
+sub delete_xattrs
+{
+    my ($neb, $key, @xattr_names) = @_;
+
+    return unless defined $neb;
+    return unless defined $key;
+    return unless scalar @xattr_names;
+
+    foreach my $arg (@xattr_names) {
+        my ($name, $value) = parse_xattr_pair($arg);
+        die "can not process $arg because it is in name:value form"
+            if defined $value;
+        $neb->removexattr($key, $name)
+            or die $neb->err;
+    }
+
+    return 1;
+}
+
+
+sub parse_xattr_pair
+{
+    my $pair = shift;
+    
+    return unless defined $pair;
+
+    no warnings qw( uninitialized );
+    my ($name, $value) = split(/:/, $pair);
+    use warnings;
+
+    return ($name, $value);
+}
+
+
 1;
 
