Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

commandline ftpssl client with Perl

by zentara (Archbishop)
on Jul 05, 2014 at 16:37 UTC ( #1092377=CUFP: print w/ replies, xml ) Need Help??

Recently, all my c-based ftpssl programs stopped working with ssl, namely gftp and lftp. I found that Net::FTPSSL still works great, but it isn't interactive, it allows just automated scripting. So, how to make an interactive session? I first thought of using a gui, but there was no real advantage to the gui, over the commandline, ( not without a huge amount of work ;-) ), so a simple commandline program fit the bill. Here it is. There is a second program below it, which runs it from a pty, in anticipation of channeling it into a Tk or GTk gui; but the gui's seems to have difficulty capturing the tty. If anyone can show how to get the ftpssl tty pty output into a textbox, I would be grateful.

If you want to experiment on your own machine, Proftd works good when configured with --enable-tls, you can google for instructions.

I used a little eval trick to pass the commands into the pty.

Some common commands : list pwd cwd noop nlst mkdir('foo') rmdir('foo') put('somelocalfile', 'remotefile')

The method set that comes with Net::FTPSSL is simple and easy.

ftps-z: runs standalone or thru a pty as shown below

#!/usr/bin/perl use strict; use warnings; use Net::FTPSSL; my $server = "127.0.0.1"; my $username = "someuser"; my $passwd = "somepass"; my @ret; my $ftps = Net::FTPSSL->new($server, Encryption => EXP_CRYPT, Debug => 1, # Croak => 1, ) or die "Can't open $server\n$Net::FTPSSL::ERRSTR"; $ftps->login($username, $passwd) or error("Credential error, $ftps->last_message"); # get default listing and pwd @ret = $ftps->list() or error("Command error, $ftps->last_message"); print "####################\n"; print join "\n", @ret,"\n"; print "####################\n"; # get default pwd @ret = $ftps->pwd or error("Command error, $ftps->last_message"); print "####################\n"; print join "\n", @ret,"\n"; print "####################\n"; if( -t STDIN ) { print "tty\n"; } while(1){ print "Hit Control-C to exit ... otherwise:\n"; print "Enter command: \n"; my $com = <STDIN>; chomp $com; if ($com =~ m/quit/){ print "exiting\n";} # needed this eval to get ftps methods to work with pty my @ret = eval "\$ftps->$com"; if($@) { print "@_\n"; } print "####################\n"; print join "\n", @ret,"\n"; print "####################\n"; if ($com =~ m/quit/){ print "exit command received, ftpssl exiting\n"; + print "Control-C to exit pty, or Shift-PageUp to + view log\n"; last; } } print "at end\n"; exit;
IO-Pty-driver for above ftps-z
#!/usr/bin/perl -w # Description: Fool a process into # thinking that STDOUT is a terminal, when in fact # basic PTY code from etcshadow use warnings; use strict; use IO::Pty; $SIG{CHLD} = 'IGNORE'; # for when we quit the ftpssl session my $pty = IO::Pty->new; my $slave = $pty->slave; open TTY,"/dev/tty" or die "not connected to a terminal\n"; $pty->clone_winsize_from(\*TTY); close TTY; my $pid = fork(); die "bad fork: $!\n" unless defined $pid; if (!$pid) { open STDOUT,">&=".$pty->fileno() or die $!; exec "./ftps-z"; }else{ $pty->close(); while (defined (my $line = <$slave>)) { print $line; } } while(1){ my $command = <>; print $slave "$command\n"; }

I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh

Comment on commandline ftpssl client with Perl
Select or Download Code
Re: commandline ftpssl client ... a Tk frontend with Perl
by zentara (Archbishop) on Jul 05, 2014 at 20:25 UTC
    Well, I have a Tk version going if anyone is interested. I couldn't use IPC::Open3 or a PTY to run Net::FTPSSL , but threads to the rescue. I put the FTPSSL code in a thread, and get output back thru a pipe. I have a bunch of $ftps->last_message sprinkled in here, to try and grab all the debug output which is available on STDERR. If anyone knows how to get all the FTPSSL debug output from the STDERR in the thread, please enlighten me. :-)

    If you want to see the full dubug connection output, run this from a xterm, and watch the debug out put in the xterm.

    A Tk version:

    #!/usr/bin/perl use warnings; use strict; use threads; use threads::shared; use IO::Pipe; my $com:shared = ''; my $go:shared = 0; my $die:shared = 0; my $val = 0; my $pipe = IO::Pipe->new(); #create thread before any tk code is called my $thr = threads->create( \&worker,$pipe ); # call reader after $pipe is connected to thread my $rh = $pipe->reader(); use Tk; my $mw = MainWindow->new(); $mw->protocol('WM_DELETE_WINDOW' => sub { &clean_exit }); $mw->fontCreate('big', -weight=>'bold', -size=> 24 ); $mw->fontCreate('medium', -weight=>'bold', -size=> 16 ); my $log = $mw->Scrolled('Text', -bg =>'black', -fg=> 'yellow', -font => 'medium', -scrollbars=>'osoe', )->pack(-expand=>1,-fill=>'both'); $log->tagConfigure( 'skyblue', -foreground => 'skyblue' ); $log -> Subwidget("yscrollbar")->configure( -background => '#dd5555', -activebackground => '#ff8888', -troughcolor => '#eeeeff', ); my $ent = $mw->Entry(-bg=>'white', -font => 'big')->pack(-expand=>1, -fill=>'x'); $mw->bind('<Any-Enter>' => sub { $ent->Tk::focus }); $ent->bind('<Return>' => \&send_command ); my $button2 = $mw->Button( -text => 'Exit', -command => \&clean_exit, )->pack(); $mw->fileevent($rh, readable => sub { my $line = <$rh>; if ($line =~ m/Doing ftpssl command:/){ $log->insert('end', $line, 'skyblue' ); }else{ $log->insert('end', $line); } $log->see('end'); } ); MainLoop; sub clean_exit{ my @running_threads = threads->list; if (scalar(@running_threads) < 1){print "\nFinished\n";exit} else{ $die = 1; $thr->join; exit; } } sub send_command{ #prevent a race condition with setting $go:shared if( $go == 1){ $log->insert('end',"Please wait for previous command to finish\ +n", 'red'); }else{ my $text = $ent->get; $ent->delete(qw/0 end/); $com = $text; $go = 1; } } # no Tk code in thread sub worker { my($pipe) = @_; my $wh = $pipe->writer; $wh->autoflush(1); use Net::FTPSSL; my $server = "127.0.0.1"; my $username = "someuser"; my $passwd = "somepass"; my @ret; @ret = my $ftps = Net::FTPSSL->new($server, Encryption => EXP_CRYPT, Debug => 1, # Croak => 1, ) or die "Can't open $server\n$Net::FTPSSL::ERRSTR"; print "####################\n"; print $wh join "\n", @ret,"\n"; print "####################\n"; print $wh $ftps->last_message, "\n"; @ret = $ftps->login($username, $passwd) or error("Credential error, $ftps->last_message"); print "####################\n"; print $wh join "\n", @ret,"\n"; print "####################\n"; print $wh $ftps->last_message, "\n"; # get default listing and pwd @ret = $ftps->list() or error("Command error, $ftps->last_message"); print "####################\n"; print $wh join "\n", @ret,"\n"; print "####################\n"; print $wh $ftps->last_message, "\n"; # get default pwd @ret = $ftps->pwd or error("Command error, $ftps->last_message"); print "####################\n"; print $wh join "\n", @ret,"\n"; print "####################\n"; print $wh $ftps->last_message, "\n"; while(1){ if($die){return} if($go){ print $wh "\n\nDoing ftpssl command: $com\n\n"; my @ret = eval "\$ftps->$com"; if($@) { print $wh "Unknown command: error: $com: @_\n"; }else{ foreach my $line( @ret){ print $wh "$line\n"; } print $wh $ftps->last_message, "\n"; } print $wh "\n"; $go = 0; #turn self off before sleeping } select(undef,undef,undef,.01); } }

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh

      You don't lock any of the shared variables; race conditions make for nasty bugs. Any reason not to use Thread::Queue?

        Good criticisms. I don't use Thread::Queue because I like to keep full control over my thread .... A queue seems to be an added abstraction layer, although if you know a way to make it easily work in my Tk code, feel free to post it.

        I think I will make the input entry insensitive, so that $go and $com pose no threat.

        I'm trying to figure out Git, so I can make a repository, for these apps. Everyone sees a way to improve it. :-)


        I'm not really a human, but I play one on earth.
        Old Perl Programmer Haiku ................... flash japh

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://1092377]
Approved by hippo
Front-paged by johngg
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (5)
As of 2014-12-22 02:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (110 votes), past polls