Net-SFTP-SftpServer
view release on metacpan or search on metacpan
lib/Net/SFTP/SftpServer.pm view on Meta::CPAN
SSH2_FXP_CLOSE() => 'SSH2_FXP_CLOSE',
SSH2_FXP_READ() => 'SSH2_FXP_READ',
SSH2_FXP_WRITE() => 'SSH2_FXP_WRITE',
SSH2_FXP_LSTAT() => 'SSH2_FXP_LSTAT',
SSH2_FXP_FSTAT() => 'SSH2_FXP_FSTAT',
SSH2_FXP_SETSTAT() => 'SSH2_FXP_SETSTAT',
SSH2_FXP_FSETSTAT() => 'SSH2_FXP_FSETSTAT',
SSH2_FXP_OPENDIR() => 'SSH2_FXP_OPENDIR',
SSH2_FXP_READDIR() => 'SSH2_FXP_READDIR',
SSH2_FXP_REMOVE() => 'SSH2_FXP_REMOVE',
SSH2_FXP_MKDIR() => 'SSH2_FXP_MKDIR',
SSH2_FXP_RMDIR() => 'SSH2_FXP_RMDIR',
SSH2_FXP_REALPATH() => 'SSH2_FXP_REALPATH',
SSH2_FXP_STAT() => 'SSH2_FXP_STAT',
SSH2_FXP_RENAME() => 'SSH2_FXP_RENAME',
SSH2_FXP_READLINK() => 'SSH2_FXP_READLINK',
SSH2_FXP_SYMLINK() => 'SSH2_FXP_SYMLINK',
SSH2_FXP_EXTENDED() => 'SSH2_FXP_EXTENDED',
ALL() => 'ALL',
NET_SFTP_SYMLINKS() => 'NET_SFTP_SYMLINKS',
NET_SFTP_RENAME_DIR() => 'NET_SFTP_RENAME_DIR',
};
use constant ACTIONS => [
ALL,
NET_SFTP_SYMLINKS,
NET_SFTP_RENAME_DIR,
SSH2_FXP_OPEN,
SSH2_FXP_CLOSE,
SSH2_FXP_READ,
SSH2_FXP_WRITE,
SSH2_FXP_LSTAT,
SSH2_FXP_STAT_VERSION_0,
SSH2_FXP_FSTAT,
SSH2_FXP_SETSTAT,
SSH2_FXP_FSETSTAT,
SSH2_FXP_OPENDIR,
SSH2_FXP_READDIR,
SSH2_FXP_REMOVE,
SSH2_FXP_MKDIR,
SSH2_FXP_RMDIR,
SSH2_FXP_STAT,
SSH2_FXP_RENAME,
SSH2_FXP_READLINK,
SSH2_FXP_SYMLINK,
];
use constant STATUS_MESSAGE => [
"Success", #/* SSH2_FX_OK */
"End of file", #/* SSH2_FX_EOF */
"No such file", #/* SSH2_FX_NO_SUCH_FILE */
"Permission denied", #/* SSH2_FX_PERMISSION_DENIED */
"Failure", #/* SSH2_FX_FAILURE */
"Bad message", #/* SSH2_FX_BAD_MESSAGE */
"No connection", #/* SSH2_FX_NO_CONNECTION */
"Connection lost", #/* SSH2_FX_CONNECTION_LOST */
"Operation unsupported", #/* SSH2_FX_OP_UNSUPPORTED */
"Unknown error" #/* Others */
];
my $USER = getpwuid($>);
my $ESCALATE_DEBUG = 0;
# --------------------------------------------------------------------
# Do evilness with symbol tables to ge
sub import{
my $self = shift;
my $opt = {};
if (ref $_[0] eq 'HASH'){
$opt = shift;
}
$opt->{log} ||= 'daemon';
initLog($opt->{log});
__PACKAGE__->export_to_level(1, $self, @_ ); # Call Exporter.
}
#-------------------------------------------------------------------------------
sub logItem {
my ($level, $prefix, @msg) = @_;
syslog $level, "[$USER]: $prefix" . join(" : ", @msg);
}
#-------------------------------------------------------------------------------
sub logDetail {
logItem( $ESCALATE_DEBUG ? 'info' : 'debug', '', @_);
}
#-------------------------------------------------------------------------------
sub logGeneral {
logItem('info', '', @_);
}
#-------------------------------------------------------------------------------
sub logWarning {
logItem('warning', 'WARNING: ', @_);
}
#-------------------------------------------------------------------------------
sub logError {
logItem('err', 'ERROR: ', @_);
}
#-------------------------------------------------------------------------------
sub initLog {
my $syslog = shift;
openlog( 'sftp', 'pid', $syslog);
my ($remote_ip, $remote_port, $local_ip, $local_port) = split(' ', $ENV{SSH_CONNECTION});
logGeneral "Client connected from $remote_ip:$remote_port";
logDetail "Client connected to $local_ip:$local_port";
}
#-------------------------------------------------------------------------------
sub getLogMsg {
my $self = shift;
my %arg = @_;
my $req = $self->{_payload}->getPayloadContent();
my $process = MESSAGE_TYPES->{$req->{message_type}};
if ($req->{handle}){
$req->{name} = $self->{_payload}->getFilename() ;
}
my $msg = '';
if (defined $arg{response} and $arg{response}->getType() == SSH2_FXP_STATUS ){
$msg = 'response: ' . STATUS_MESSAGE->[$arg{response}->getStatus()] . ' ';
}
lib/Net/SFTP/SftpServer.pm view on Meta::CPAN
$response->setStatus(SSH2_FX_NO_SUCH_FILE); # all symlinks hidden
}
#-------------------------------------------------------------------------------
sub processSymlink {
my $self = shift;
my $payload = shift;
my $response = shift;
my $req = $payload->getPayloadContent(
source_name => 'string',
target_name => 'string',
);
my $oldpath = $self->makeSafeFileName($req->{source_name});
my $newpath = $self->makeSafeFileName($req->{target_name});
$self->logAction();
return if $self->denyOperation(SSH2_FXP_SYMLINK, $response);
logError "processSymlink not implemented";
}
#-------------------------------------------------------------------------------
sub processExtended {
my $self = shift;
my $payload = shift;
my $response = shift;
my $req = $payload->getPayloadContent(
request => 'string',
);
$self->logAction();
$response->setStatus( SSH2_FX_OP_UNSUPPORTED ); #/* MUST */
}
#-------------------------------------------------------------------------------
sub denyOperation {
my $self = shift;
my ($op, $response) = @_;
if (defined $self->{deny}{$op} and $self->{deny}{$op}){
logWarning "Denying request operation: " . MESSAGE_TYPES->{$op} . ", id: " . $response->getId();
if (defined $self->{fake_ok}{$op} and $self->{fake_ok}{$op}){
$response->setStatus( SSH2_FX_OK );
}
else {
$response->setStatus( SSH2_FX_PERMISSION_DENIED );
}
return 1;
}
return;
}
#-------------------------------------------------------------------------------
sub lsFile {
my $self = shift;
my $name = shift;
my $st = shift;
my @ltime = localtime($st->[9]);
my $mode = format_mode($st->[2]);
my $user = getpwuid($st->[4]);
my $group = getgrgid($st->[5]);
my $sz;
if (scalar @ltime) {
if (time() - $st->[9] < (365*24*60*60)/2){
$sz = strftime "%b %e %H:%M", @ltime;
}
else {
$sz = strftime "%b %e %Y", @ltime;
}
}
my $ulen = length $user > 8 ? length $user : 8;
my $glen = length $group > 8 ? length $group : 8;
return sprintf("%s %3u %-*s %-*s %8llu %s %s", $mode, $st->[3], $ulen, $user, $glen, $group, $st->[7], $sz, $name);
}
#-------------------------------------------------------------------------------
sub makeSafeFileName {
my $self = shift;
# We force all file names to be treated as from / which we treat as the users home directory
my $name = shift;
$name = "/$name";
while ($name =~ s!/\./!/!g) {}
$name =~ s!//+!/!g;
my @path = split('/', $name);
my @newpath;
for my $d (@path){
if ($d eq '..'){
pop @newpath;
}
elsif ($d ne '.') {
if ($self->{valid_filename_char}){
if ($d !~ /^[$self->{valid_filename_char}]*$/){
logError "Invalid characters in $name";
return;
}
}
push @newpath, $d;
}
if ($self->{no_symlinks}){
if ( $self->{FS}->IsSymlink( join('/', @newpath) ) ){
return; # no symlinks
}
}
}
$name = join('/', @newpath) || '/';
$name =~ s!/\.$!/!;
return $name;
}
#-------------------------------------------------------------------------------
sub encodeAttrib {
my $self = shift;
my $attr = shift;
$attr->{flags} ||= 0;
my $msg = pack('N', $attr->{flags});
if ($attr->{flags} & SSH2_FILEXFER_ATTR_SIZE){
my $h = int($attr->{size} / (1 << 32));
my $l = $attr->{size} % (1 << 32);
lib/Net/SFTP/SftpServer.pm view on Meta::CPAN
=head1 HARDENED EXAMPLE SCRIPT
The following example script shows how this module can be used to give far greater control over what is allowed on your SFTP server.
This setup is aimed at admins which want to user SFTP uploads but do not wish to grant users a system account.
You will also need to set both the SFTP subsystem and the user's shell to the sftp script, eg /usr/local/bin/sftp-server.pl
This configuration:
=over
=item * Enforces that users can only access the sftp script, not an ssh shell.
=item * Chroots them into their home directory in /var/upload/sftp
=item * Sets all file permissions to 0660 and does not permit users to change them.
=item * Does not allow symlinks, making directories or renaming directories, but allows all other normal actions.
=item * Has a max upload filesize of 200Mb
=item * Has a script memory limit of 100Mb for safety
=item * Will log actions by user sftptest in debug mode
=item * Will only allow alphanumeric plus _ . and - in filenames
=item * Will call ActionOnSent and ActionOnReceived respectively when files have been sent or received.
=back
#!/usr/local/bin/perl
use strict;
use warnings;
use Net::SFTP::SftpServer ( { log => 'local5' }, qw ( :LOG :ACTIONS ) );
use BSD::Resource; # for setrlimit
use constant DEBUG_USER => {
SFTPTEST => 1,
};
# Security - make sure we have started this as sftp not ssh
unless ( scalar @ARGV == 2 and
$ARGV[0] eq '-c' and
($ARGV[1] eq '/usr/local/bin/sftp-server.pl') ){
logError "SFTP connection attempted for application $ARGV[0] - exiting";
print "\n\rYou do not have permission to login interactively to this host.\n\r\n\rPlease contact the system administrator if you believe this to be a configuration error.\n\r";
exit 1;
}
my $MEMLIMIT = 100 * 1024 * 1024; # 100 Mb
# hard limits on process memory usage;
setrlimit( RLIMIT_RSS, $MEMLIMIT, $MEMLIMIT );
setrlimit( RLIMIT_VMEM, $MEMLIMIT, $MEMLIMIT );
my $debug = (defined DEBUG_USER->{uc(getpwuid($>))} and DEBUG_USER->{uc(getpwuid($>))}) ? 1 : 0;
my $sftp = Net::SFTP::SftpServer->new(
debug => $debug,
home => '/var/upload/sftp',
file_perms => 0660,
on_file_sent => \&ActionOnSent,
on_file_received => \&ActionOnReceived,
use_tmp_upload => 1,
max_file_size => 200 * 1024 * 1024,
valid_filename_char => [ 'a' .. 'z', 'A' .. 'Z', '0' .. '9', '_', '.', '-' ],
deny => ALL,
allow => [ (
SSH2_FXP_OPEN,
SSH2_FXP_CLOSE,
SSH2_FXP_READ,
SSH2_FXP_WRITE,
SSH2_FXP_LSTAT,
SSH2_FXP_STAT_VERSION_0,
SSH2_FXP_FSTAT,
SSH2_FXP_OPENDIR,
SSH2_FXP_READDIR,
SSH2_FXP_REMOVE,
SSH2_FXP_STAT,
SSH2_FXP_RENAME,
)],
fake_ok => [ (
SSH2_FXP_SETSTAT,
SSH2_FXP_FSETSTAT,
)],
);
$sftp->run();
sub ActionOnSent {
my $fileObject = shift;
## Do Stuff
}
sub ActionOnReceived {
my $fileObject = shift;
## Do Stuff
}
=head1 DEPENDENCIES
Stat::lsMode
Fcntl
POSIX
Sys::Syslog
Errno
=head1 SEE ALSO
Sftp protocol L<http://www.openssh.org/txt/draft-ietf-secsh-filexfer-02.txt>
=head1 AUTHOR
Simon Day, Pirum Systems Ltd
cpan <at> simonday.info
( run in 0.800 second using v1.01-cache-2.11-cpan-5837b0d9d2c )