view release on metacpan or  search on metacpan

lib/Net/FTPServer/PWP/Server.pm  view on Meta::CPAN

    $self->{pwp_qfile} = $self->config('pwp quota file') || '../pwpquota';
    $self->{pwp_qfile} =~ s!\$(\w+)!$self->{$1}!g;

    my $uid = $self->config('default pwp userid');
    my $gid = $self->config('default pwp groupid');

    if (defined $uid and defined $gid) {

				# XXX - This function is not documented

	eval { $self->_drop_privs($uid, $gid, $user); };
    }

}

=pod

=item $dirh = $self->root_directory_hook;

Hook: Return an instance of Net::FTPServer::PWPDirHandle
corresponding to the root directory.

=cut

				# Set the root directory for this user and
				# also calc the usage if required
sub root_directory_hook {
    my $self = shift;

    $self->{pwp_root} = 
	new Net::FTPServer::PWP::DirHandle($self, '/');

    $self->log('debug',  "root_directory_hook: root is $self->{pwp_root_dir}")
	if $self->config('debug');

    $self->_add_space(0);	# If the quota file is too old, force
				# its rebuilding.

    return $self->{pwp_root};
}

				# Calculate current space utilization
				# and update post file
sub _calc_space {
    my $self = shift;

    $self->{pwp_space} = 0;

    unless ($self->{pwp_qhandle}) {
	$self->{pwp_qhandle} = $self->{pwp_root};

				# The quota file might be wanted outside
				# the current home directory. Therefore,
				# we need to be free from the hurdles
				# of 'hide mount point'...

	$self->{pwp_qhandle} = Net::FTPServer::Full::DirHandle 
	    -> new($self, $self->{pwp_qhandle}->{_pathname});

	my @parts = split m!/!, $self->{pwp_qfile};

	while (my $c = shift @parts) {
	    next if $c eq '' or $c eq '.';
	    if ($c eq "..") {
		$self->{pwp_qhandle} = $self->{pwp_qhandle}->parent;
	    }
	    else {
		my $h = $self->{pwp_qhandle}->get($c);

		if (!$h and !@parts) {
		    $h = $self->{pwp_qhandle}->open($c, "w");
		    unless ($h) {
			warn "Cannot create quota file ",
			$self->{pwp_qhandle}->pathname . "/$c: $!\n";
			delete $self->{pwp_qhandle};
			return undef;
		    }
		}

		$self->{pwp_qhandle} = $self->{pwp_qhandle}->get($c);

		unless 
		    ($self->{pwp_qhandle} and 
		     $self->{pwp_qhandle}->isa("Net::FTPServer::Handle"))
		{
		    warn "Invalid quota file: $self->{pwp_qfile} ($!)\n";
		    delete $self->{pwp_qhandle};
		    return undef;
		}
	    }
	}

	unless 
	    ($self->{pwp_qhandle} 
	     and $self->{pwp_qhandle}->isa("Net::FTPServer::FileHandle")) 
	{
	    warn "$self->{pwp_qhandle} Quota file seems invalid: $self->{pwp_qfile}\n";
	    delete $self->{pwp_qhandle};
	    return undef;
	}
    }

    my $fh = $self->{pwp_qhandle}->open("w");

    unless ($fh) {
	die "Failed to create ", $self->{pwp_qfile}, ": $!\n";
    }

    $self->visit($self->{pwp_root}, { 
	'f' => sub 
	{ 
#	    warn "quota f: ", $_->pathname, " adds ", ($_->status)[5], "\n";
	    $self->{pwp_space} += ($_->status)[5] 
		unless $_->pathname 
		    eq $self->{pwp_qhandle}->pathname;
	    return 1;
	},
	'd' => sub 
	{
#	    warn "quota d: ", $_->pathname, " adds ", ($_->status)[5], "\n";