view release on metacpan or  search on metacpan

lib/AFS/Command/FS.pm  view on Meta::CPAN

sub diskfree {
    my $self = shift;
    return $self->_paths_method('diskfree',@_);
}

sub examine {
    my $self = shift;
    return $self->_paths_method('examine',@_);
}

sub listquota {
    my $self = shift;
    return $self->_paths_method('listquota',@_);
}

sub quota {
    my $self = shift;
    return $self->_paths_method('quota',@_);
}

sub storebehind {
    my $self = shift;
    return $self->_paths_method('storebehind',@_);
}

sub whereis {
    my $self = shift;
    return $self->_paths_method('whereis',@_);
}

sub whichcell {
    my $self = shift;
    return $self->_paths_method('whichcell',@_);
}

sub listacl {
    my $self = shift;
    return $self->_paths_method('listacl',@_);
}

sub _paths_method {

    my $self = shift;
    my $operation = shift;
    my (%args) = @_;

    my $result = AFS::Object::CacheManager->new();

    $self->{operation} = $operation;

    my $pathkey = $operation eq 'storebehind' ? 'files' : 'path';

    return unless $self->_parse_arguments(%args);

    my $errors = 0;

    $errors++ unless $self->_exec_cmds( stderr => 'stdout' );

    my @paths = ref $args{$pathkey} eq 'ARRAY' ? @{$args{$pathkey}} : ($args{$pathkey});
    my %paths = map { $_ => 1 } @paths;

    my $default = undef; # Used by storebehind

    while ( defined($_ = $self->{handle}->getline()) ) {

	next if /^Volume Name/;

	my $path = AFS::Object::Path->new();

	if ( /fs: Invalid argument; it is possible that (.*) is not in AFS./ ||
	     /fs: no such cell as \'(.*)\'/ ||
	     /fs: File \'(.*)\' doesn\'t exist/ ||
	     /fs: You don\'t have the required access rights on \'(.*)\'/ ) {

	    $path->_setAttribute
	      (
	       path 		=> $1,
	       error		=> $_,
	      );

	    delete $paths{$1};
	    @paths = grep($_ ne $1,@paths);

	} else {

	    if ( $operation eq 'listacl' ) {

		if ( /^Access list for (.*) is/ ) {

		    $path->_setAttribute( path => $1 );
		    delete $paths{$1};

		    my $normal 		= AFS::Object::ACL->new();
		    my $negative 	= AFS::Object::ACL->new();

		    my $type = 0;

		    while ( defined($_ = $self->{handle}->getline()) ) {

			s/^\s+//g;
			s/\s+$//g;
			last if /^\s*$/;

			$type = 1, next if /^Normal rights:/;
			$type = -1, next if /^Negative rights:/;

			my ($principal,$rights) 	= split;

			if ( $type == 1 ) {
			    $normal->_addEntry( $principal => $rights );
			} elsif ( $type == -1 ) {
			    $negative->_addEntry( $principal => $rights );
			}

		    }

		    $path->_setACLNormal($normal);
		    $path->_setACLNegative($negative);

		}

lib/AFS/Command/FS.pm  view on Meta::CPAN

    return if $errors;
    return $result;

}

sub listcells {

    my $self = shift;
    my (%args) = @_;

    my $result = AFS::Object::CacheManager->new();

    $self->{operation} = "listcells";

    return unless $self->_parse_arguments(%args);

    return unless $self->_save_stderr();

    my $errors = 0;

    $errors++ unless $self->_exec_cmds();

    while ( defined($_ = $self->{handle}->getline()) ) {

	if ( /^Cell (\S+) on hosts (.*)\.$/ ) {
	    my $cell = AFS::Object::Cell->new
	      (
	       cell			=> $1,
	       servers			=> [split(/\s+/,$2)],
	      );
	    $result->_addCell($cell);
	}

    }

    $errors++ unless $self->_reap_cmds();
    $errors++ unless $self->_restore_stderr();

    return if $errors;
    return $result;

}

sub lsmount {

    my $self = shift;
    my (%args) = @_;

    my $result = AFS::Object::CacheManager->new();

    $self->{operation} = "lsmount";

    return unless $self->_parse_arguments(%args);

    my $errors = 0;

    $errors++ unless $self->_exec_cmds( stderr => 'stdout' );

    my @dirs = ref $args{dir} eq 'ARRAY' ? @{$args{dir}} : ($args{dir});
    my %dirs = map { $_ => 1 } @dirs;

    while ( defined($_ = $self->{handle}->getline()) ) {

	my $current = shift @dirs;
	delete $dirs{$current};

	my $path = AFS::Object::Path->new( path => $current );

	if ( /fs: Can.t read target name/ ) {
	    $path->_setAttribute( error => $_ );
	} elsif ( /fs: File '.*' doesn't exist/ ) {
	    $path->_setAttribute( error => $_ );
	} elsif ( /fs: you may not use \'.\'/ ) {
	    $_ .= $self->{handle}->getline();
	    $path->_setAttribute( error => $_ );
	} elsif ( /\'(.*?)\' is not a mount point/ ) {
	    $path->_setAttribute( error => $_ );
	} elsif ( /^\'(.*?)\'.*?\'(.*?)\'$/ ) {

	    my ($dir,$mount) = ($1,$2);

	    $path->_setAttribute( symlink => 1 ) if /symbolic link/;
	    $path->_setAttribute( readwrite => 1 ) if $mount =~ /^%/;
	    $mount =~ s/^(%|\#)//;

	    my ($volname,$cell) = reverse split(/:/,$mount);

	    $path->_setAttribute( volname => $volname );
	    $path->_setAttribute( cell => $cell) if $cell;

	} else {

	    $self->_Carp("fs lsmount: Unrecognized output: '$_'");
	    $errors++;
	    next;

	}

	$result->_addPath($path);

    }

    foreach my $dir ( keys %dirs ) {
        my $path = AFS::Object::Path->new
          (
           path			=> $dir,
           error		=> "Unable to determine results",
          );
        $result->_addPath($path);
    }

    $errors++ unless $self->_reap_cmds( allowstatus => 1 );

    return if $errors;
    return $result;

}

#
# This is deprecated in newer versions of OpenAFS