view release on metacpan or  search on metacpan

lib/Fuse/PerlSSH/FS.pm  view on Meta::CPAN

				remote_mkdir    => q{	# because PerlSSH's mkdir does not propagate the 2nd param $mode (mask)
					my $result = mkdir($_[0],$_[1]) or die "Cannot mkdir('$_[0]','$_[1]') - $!";
					return $result;
				},
				remote_link     => q{ return link($_[0],$_[1]) or die "Cannot link('$_[0]','$_[1]') - $!"; },
				remote_truncate => q{	# because PerlSSH's truncate only works on filehandles
					return truncate($_[0],$_[1]) or die "Cannot truncate('$_[0]','$_[1]') - $!";
				},
				remote_readdir  => q{	# because PerlSSH's readdir removes dotfiles
					opendir( my $dh, $_[0] ) or die "Cannot opendir('$_[0]') - $!";
					my @ents = readdir($dh);
					return @ents;
				},
				statfs	=> q{
					# @_ = (root,method)
					my ($blocks,$bavail) = (10000000,5000000);
					if($_[1] eq 'dfportable'){
						my $df = dfportable($_[0]);
						$blocks = $df->{blocks} if defined($df);
						$bavail = $df->{bavail} if defined($df);
					}elsif($_[1] eq 'df'){
						my @df = `df $_[0]`;
						(my $fsystem,$blocks,my $bused,$bavail,my $capacity,my $mounted) = split(/\s+/,$df[1]);
						$blocks = $blocks if $df[1];
						$bavail = $bavail if $df[1];
					}

					return (255,1000000,500000,$blocks,$bavail,1024);
				}, # a pseudo statfs
				remote_listxattr => q{
					use File::ExtAttr;
					my @list = File::ExtAttr::listfattr($_[0]) or die "Cannot listfattr('$_[0]') - $!";
					for(@list){ $_ = 'user.'.$_ if $_ !~ /\./; } # fix missing ns
					return @list;
				},
				remote_getxattr => q{
					use File::ExtAttr;
					die "Cannot getfattr('$_[0]','$_[1]') - no namespace" if $_[1] !~ /\./;
					my ($ns,$key) = split(/\./,$_[1],2);
				#	return " (".$ns.":$key) ".File::ExtAttr::getfattr($_[0], $key, { namespace => $ns }) or die "Cannot getfattr('$_[0]','$_[1]') - $!";
					return File::ExtAttr::getfattr($_[0], $key, { namespace => $ns }) or die "Cannot getfattr('$_[0]','$_[1]') - $!";
				},
				remote_setxattr => q{
					use File::ExtAttr;
					die "Cannot setfattr('$_[0]','$_[1]','$_[2]','$_[3]') - no namespace" if $_[1] !~ /\./;
					my ($ns,$key) = split(/\./,$_[1],2);

					# File::ExtAttr: %flags allows control of whether the attribute should be created or should replace an existing attribute's value.
					# If the key create is true, setfattr will fail if the attribute already exists. If the key replace is true, setfattr will fail if the attribute does not already exist. If neither is specified, then the attribute will be created (if necessary) o...
					my %flags = (create => 1);
					%flags = (replace => 1) if $_[3] > 1; # OR-ed constants are XATTR_CREATE 1, XATTR_REPLACE 2
					return File::ExtAttr::setfattr($_[0], $key, $_[2], { namespace => $ns, %flags }) or die "Cannot setfattr('$_[0]','$_[1]','$_[2]','$_[3]') - $!";
				},
				remote_removexattr => q{
					use File::ExtAttr;
					die "Cannot delfattr('$_[0]','$_[1]') - no namespace" if $_[1] !~ /\./;
					my ($ns,$key) = split(/\./,$_[1],2);
					File::ExtAttr::delfattr($_[0], $key, { namespace => $ns }) or die "Cannot delfattr('$_[0]','$_[1]') - $!";
				},
			);
			$self->{ssh}->use_library('FS', qw( chown chmod lstat readlink rename rmdir symlink unlink utime ) );
			$self->{ssh}->use_library('Fuse::PerlSSH::RemoteFunctions');

			my $rval;
			eval { $rval = $self->_remote->call("test_connection"); };
			die "Fuse::PerlSSH::FS ssh connection not working!" if $@;
			print STDERR "## _remote: test_connection: ".Dumper($rval) if $self->{debug};
		}else{
			die "Fuse::PerlSSH::FS was not able to log in to host $self->{host} on port $self->{port} with user $self->{user}";
			return undef;
		}
	}
	
	return $self->{ssh};
}

sub mount {
	my $self = shift;

	## check local mount point
	if(!-d $self->{mountpoint}){
		die 'Fuse::PerlSSH::FS: Mountpoint '.$self->{mountpoint}.' does not exists!';
	}

	my %add_xattr;
	if($self->{no_xattr}){
		print STDERR "## mount: xattr bindings omitted. --no-xattr option in effect.\n" if $self->{debug};
	}elsif(!$self->{capabilities}->{can_xattr}){
		print STDERR "## mount: xattr bindings omitted. Remote host seems to be incapable.\n" if $self->{debug};
	}else{
		%add_xattr = (
			listxattr=> \&local_listxattr,
			getxattr => \&local_getxattr,
			setxattr => \&local_setxattr,
			removexattr=>\&local_removexattr,
		);
	}

	my %fuse = (
		mountpoint => $self->{mountpoint},
		threaded   => $self->{threaded} ? 1 : 0,
		debug	   => $self->{debug} > 1 ? 1 : 0,

		readdir	 => \&local_readdir,
		getattr	 => \&local_getattr,
		mknod	 => \&local_mknod,
		mkdir	 => \&local_mkdir,
		rmdir	 => \&local_rmdir,
		rename	 => \&local_rename,
		unlink	 => \&local_unlink,
		open	 => \&local_open,
		read	 => \&local_read,
		write	 => \&local_write,
		release	 => \&local_release,
		symlink	 => \&local_symlink,
		link	 => \&local_link,
		readlink => \&local_readlink,
		utime	 => \&local_utime,
		truncate => \&local_truncate,
		ftruncate=> \&local_ftruncate,
		statfs	 => \&local_statfs,