r3705 - in /packages/libnet-lite-ftp-perl: ./ trunk/ trunk/debian/
trunk/lib/ trunk/lib/Net/ trunk/lib/Net/Lite/ trunk/t/
sukria at users.alioth.debian.org
sukria at users.alioth.debian.org
Tue Sep 12 08:00:48 UTC 2006
Author: sukria
Date: Tue Sep 12 08:00:45 2006
New Revision: 3705
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=3705
Log:
Initial import of the libnet-lite-ftp-perl package.
Added:
packages/libnet-lite-ftp-perl/
packages/libnet-lite-ftp-perl/trunk/
packages/libnet-lite-ftp-perl/trunk/Changes
packages/libnet-lite-ftp-perl/trunk/L8R.txt
packages/libnet-lite-ftp-perl/trunk/M.yml
packages/libnet-lite-ftp-perl/trunk/MANIFEST
packages/libnet-lite-ftp-perl/trunk/Makefile.PL
packages/libnet-lite-ftp-perl/trunk/Meta.yml
packages/libnet-lite-ftp-perl/trunk/README
packages/libnet-lite-ftp-perl/trunk/debian/
packages/libnet-lite-ftp-perl/trunk/debian/changelog
packages/libnet-lite-ftp-perl/trunk/debian/compat
packages/libnet-lite-ftp-perl/trunk/debian/control
packages/libnet-lite-ftp-perl/trunk/debian/copyright
packages/libnet-lite-ftp-perl/trunk/debian/rules (with props)
packages/libnet-lite-ftp-perl/trunk/example.pl (with props)
packages/libnet-lite-ftp-perl/trunk/lib/
packages/libnet-lite-ftp-perl/trunk/lib/Net/
packages/libnet-lite-ftp-perl/trunk/lib/Net/Lite/
packages/libnet-lite-ftp-perl/trunk/lib/Net/Lite/FTP.pm
packages/libnet-lite-ftp-perl/trunk/t/
packages/libnet-lite-ftp-perl/trunk/t/Net-Lite-FTP.t
Added: packages/libnet-lite-ftp-perl/trunk/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-lite-ftp-perl/trunk/Changes?rev=3705&op=file
==============================================================================
--- packages/libnet-lite-ftp-perl/trunk/Changes (added)
+++ packages/libnet-lite-ftp-perl/trunk/Changes Tue Sep 12 08:00:45 2006
@@ -1,0 +1,78 @@
+Revision history for Perl extension Net::Lite::FTP.
+
+0.47 - fix response, fix size, introduce rawmessage
+0.46 - mdtm support
+0.45 - improved logging (damn undefined response)
+0.44 - NLST processing, 1xx response means - data follows, 2xx means you can close the socket,
+ 200 Series: The requested action has been successfully completed.
+ 100 Series: The requested action is being initiated, expect another reply before proceeding with a new command.
+ 4xx, 5xx - errors.
+0.43 - Meta.yml test
+0.42 - die ..
+0.41 - putt error code in ErrMSG (this probably still needs fixing)
+ fix 0.40(double get), undef on error in reponse.
+0.40 - try to fail when RETR fails -
+ reported by Maria Ian, should fix RT#17847
+0.39 - try to fail when STOR(APPE) fails - like
+ put: Access failed: 550 cpuinfo: Overwrite permission denied
+0.37
+ - APPE - appe(), blatappe() support.
+0:36
+ - rollback
+
+0:34 Wed Nov 30 09:43:41 CET 2005
+ - move PBSZ and PROT P until AFTER logged in..
+0.32 Tue Oct 11 20:03:12 CEST 2005
+ - complete datasocket conversion
+0.31 Tue Oct 11 19:53:38 CEST 2005
+ - PASV refactoring step 1 - datasocket method,
+0.30 Thu Apr 14 22:23:11 CEST 2005
+ - DELE/rm/delete method, thanks to Edward Mann
+
+0.28 Wed Mar 30 21:02:24 CEST 2005
+ - new method $ftp->quit()
+ - callbacks Get|Put Update and (Get|Put)Done
+ - 0.28 is based on Daniel Akesson version, thanks.
+0.26
+ - another fix for multiline MOTD
+0.25
+ - Fix initial server line handling (support multiline MOTD)
+0.23
+ - use IO::Handle
+0.22
+ - use binmode for reading/writing files. TODO: let user use ASCII mode.
+0.21
+ - Use \r\n instead of \n like RFC requires..
+
+0.20 Sat Feb 12 20:31:26 CET 2005
+ - relax 'use perl', we should work equally well on 5.6.0
+
+0.19
+ - EncryptData=0 behaviour changed. We no longer send "PROT C", "PROT P" at every command.
+ - $ftp->message() command returns last response from FTP server.
+ - bug - pureftpd tends to return strange line as reply to 'PASV', we
+ now die instead of hanging indefinitely. (TODO - rething error handling)
+
+0.17 Mon Jan 24 18:49:25 CET 2005
+ - use unique IO::Handle for every connection instead of 3 global globs.(BROWN PAPERBAG BUG!)
+ - cdup
+ - slowly improving error handling...
+
+0.12 Tue Jan 18 19:48:52 CET 2005
+ - rename("from","to") introduced
+ - NLST and LIST fixed (thanx to Pablo Valenzuela)
+ - PBSZ and PROT no longer required in client code.
+ - SIZE implemented (thanx to Pablo Valenzuela)
+ - login ( user, pass )
+0.10 Tue Jan 18 09:19:53 CET 2005
+ - Debug, EncryptData properties. Documentation fixed.
+0.09 Fri Jan 7 20:41:03 CET 2005
+ - get and put are working, so are slurp and blat.
+0.06 Wed Jan 5 09:55:51 CET 2005
+ - NLST, GET, PUT
+0.02 Wed Jan 5 09:55:51 CET 2005
+ - hello world version
+0.01 Wed Jan 5 09:54:58 2005
+ - original version; created by h2xs 1.23 with options
+ -Xn Net::Lite::FTP
+
Added: packages/libnet-lite-ftp-perl/trunk/L8R.txt
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-lite-ftp-perl/trunk/L8R.txt?rev=3705&op=file
==============================================================================
--- packages/libnet-lite-ftp-perl/trunk/L8R.txt (added)
+++ packages/libnet-lite-ftp-perl/trunk/L8R.txt Tue Sep 12 08:00:45 2006
@@ -1,0 +1,37 @@
+#
+sub list {
+ my ($self)=@_;
+ my $sock=$self->{'Sock'};
+ my $socket;
+ my (@files);
+ my $q;
+ $q=$self->command("PASV");
+ $q=~/227 [^\d]*(\d+),(\d+),(\d+),(\d+),(\d+),(\d+)/ && do {
+ #print "I przyszlo $1 $2 $3 $4 $5 $6, port ",$5*256+$6,"\n";
+ my $port=$5*256+$6;
+ my $host="$1.$2.$3.$4";
+ #print " $host : $port \n";
+ $socket = Net::SSLeay::Handle->make_socket($host, $port);
+ print STDERR "Data link connected.. to $host at $port\n";
+ };
+ $self->command("LIST");
+
+ tie(*S2, "Net::SSLeay::Handle", $socket);
+ print STDERR "SSL for data connection enabled...\n";
+ $socket = \*S2;
+
+ while ($q=<$socket>) {
+ print STDERR "G: $q";
+ #IBM Style:
+ $q=~/([a-zA-Z0-9\.\_]+)\s+(\w+)\s+(\w+)\s+([a-zA-Z\#]+)\s+(\d+)\s+(\d+)\s+(\d+)/ && do {
+ my ($file,$sender,$class,$sth,$size,$date,$time)=($1,$2,$3,$4,$5,$6,$7);
+ print STDERR "Plik ($file) by sender($sender) of class($class) with size ($size)\n";
+ push @files,$file;
+ };
+ };
+ close $socket;
+ print STDERR "resp(end LIST) ",$self->response();
+ return \@files;
+
+};
+
Added: packages/libnet-lite-ftp-perl/trunk/M.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-lite-ftp-perl/trunk/M.yml?rev=3705&op=file
==============================================================================
--- packages/libnet-lite-ftp-perl/trunk/M.yml (added)
+++ packages/libnet-lite-ftp-perl/trunk/M.yml Tue Sep 12 08:00:45 2006
@@ -1,0 +1,8 @@
+--- #YAML:1.0
+name: Net-FTP-Throttle
+version: 0.30
+author:
+ - Leon Brocard <acme at astray.com>
+abstract:
+license: perl
+generated_by: Module::Build version 0.2611, without YAML.pm
Added: packages/libnet-lite-ftp-perl/trunk/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-lite-ftp-perl/trunk/MANIFEST?rev=3705&op=file
==============================================================================
--- packages/libnet-lite-ftp-perl/trunk/MANIFEST (added)
+++ packages/libnet-lite-ftp-perl/trunk/MANIFEST Tue Sep 12 08:00:45 2006
@@ -1,0 +1,6 @@
+Changes
+Makefile.PL
+MANIFEST
+README
+t/Net-Lite-FTP.t
+lib/Net/Lite/FTP.pm
Added: packages/libnet-lite-ftp-perl/trunk/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-lite-ftp-perl/trunk/Makefile.PL?rev=3705&op=file
==============================================================================
--- packages/libnet-lite-ftp-perl/trunk/Makefile.PL (added)
+++ packages/libnet-lite-ftp-perl/trunk/Makefile.PL Tue Sep 12 08:00:45 2006
@@ -1,0 +1,13 @@
+use 5.006000;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ NAME => 'Net::Lite::FTP',
+ VERSION_FROM => 'lib/Net/Lite/FTP.pm', # finds $VERSION
+ PREREQ_PM => { Net::SSLeay::Handle=>0.0, }, # e.g., Module::Name => 1.1
+ LICENCE => 'perl',
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'lib/Net/Lite/FTP.pm', # retrieve abstract from module
+ AUTHOR => 'Dariush Pietrzak <cpan at forumakad.pl>') : ()),
+);
Added: packages/libnet-lite-ftp-perl/trunk/Meta.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-lite-ftp-perl/trunk/Meta.yml?rev=3705&op=file
==============================================================================
--- packages/libnet-lite-ftp-perl/trunk/Meta.yml (added)
+++ packages/libnet-lite-ftp-perl/trunk/Meta.yml Tue Sep 12 08:00:45 2006
@@ -1,0 +1,12 @@
+--- #YAML:1.0
+name: Net-Lite-FTP
+version: 0.43
+version_from: VERSION
+author:
+ - Dariush Pietrzak <cpan at ghost.anime.pl>
+abstract:
+license: perl
+requires:
+ Net::SSLeay::Handle: 0.0
+generated_by: Eyck v1.01
+distribution_type: module
Added: packages/libnet-lite-ftp-perl/trunk/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-lite-ftp-perl/trunk/README?rev=3705&op=file
==============================================================================
--- packages/libnet-lite-ftp-perl/trunk/README (added)
+++ packages/libnet-lite-ftp-perl/trunk/README Tue Sep 12 08:00:45 2006
@@ -1,0 +1,45 @@
+Net-Lite-FTP version 0.21
+=========================
+
+Usage:
+ my $tlsftp=Net::Lite::FTP->new();
+ $tlsftp->open("ftp.tls.pl","21");
+ $tlsftp->user("user");
+ $tlsftp->pass("password");
+ $tlsftp->cwd("pub");
+ my $files=$tlsftp->nlist("*.exe");
+ foreach $f (@$files) {
+ $tlsftp->get($f);
+ };
+
+
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ Net::SSLeay::Handle
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2005 by Dariush Pietrzak
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.4 or,
+at your option, any later version of Perl 5 you may have available.
+
Added: packages/libnet-lite-ftp-perl/trunk/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-lite-ftp-perl/trunk/debian/changelog?rev=3705&op=file
==============================================================================
--- packages/libnet-lite-ftp-perl/trunk/debian/changelog (added)
+++ packages/libnet-lite-ftp-perl/trunk/debian/changelog Tue Sep 12 08:00:45 2006
@@ -1,0 +1,7 @@
+libnet-lite-ftp-perl (0.47-1) unstable; urgency=low
+
+ * Initial Release, closes ITP.
+ (closes: #386556)
+
+ -- Alexis Sukrieh <sukria at debian.org> Fri, 8 Sep 2006 16:02:58 +0200
+
Added: packages/libnet-lite-ftp-perl/trunk/debian/compat
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-lite-ftp-perl/trunk/debian/compat?rev=3705&op=file
==============================================================================
--- packages/libnet-lite-ftp-perl/trunk/debian/compat (added)
+++ packages/libnet-lite-ftp-perl/trunk/debian/compat Tue Sep 12 08:00:45 2006
@@ -1,0 +1,1 @@
+5
Added: packages/libnet-lite-ftp-perl/trunk/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-lite-ftp-perl/trunk/debian/control?rev=3705&op=file
==============================================================================
--- packages/libnet-lite-ftp-perl/trunk/debian/control (added)
+++ packages/libnet-lite-ftp-perl/trunk/debian/control Tue Sep 12 08:00:45 2006
@@ -1,0 +1,16 @@
+Source: libnet-lite-ftp-perl
+Section: perl
+Priority: optional
+Build-Depends: debhelper (>= 5.0.0)
+Build-Depends-Indep: perl (>= 5.6.0)
+Maintainer: Alexis Sukrieh <sukria at debian.org>
+Standards-Version: 3.7.2
+
+Package: libnet-lite-ftp-perl
+Architecture: all
+Depends: ${perl:Depends}, ${misc:Depends}, libnet-ssleay-perl
+Description: Perl FTP client with support for TLS
+ Perl library for establishing secured FTP connections (FTP TLS).
+ The API is designed in an object-oriented manner.
+ .
+ This package provides the Net::Lite::FTP Perl module.
Added: packages/libnet-lite-ftp-perl/trunk/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-lite-ftp-perl/trunk/debian/copyright?rev=3705&op=file
==============================================================================
--- packages/libnet-lite-ftp-perl/trunk/debian/copyright (added)
+++ packages/libnet-lite-ftp-perl/trunk/debian/copyright Tue Sep 12 08:00:45 2006
@@ -1,0 +1,16 @@
+This is the debian package for the Net::Lite::FTP module.
+It was created by Alexis Sukrieh <sukria at debian.org>.
+
+The upstream author is: Dariush Pietrzak <cpan at ghost.anime.pl>.
+
+Copyright (C) 2005 by Dariush Pietrzak
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.4 or,
+at your option, any later version of Perl 5 you may have available.
+
+On Debian systems the complete text of the GPL and Artistic
+licenses can be found at:
+ /usr/share/common-licenses/GPL and
+ /usr/share/common-licenses/Artistic
+
Added: packages/libnet-lite-ftp-perl/trunk/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-lite-ftp-perl/trunk/debian/rules?rev=3705&op=file
==============================================================================
--- packages/libnet-lite-ftp-perl/trunk/debian/rules (added)
+++ packages/libnet-lite-ftp-perl/trunk/debian/rules Tue Sep 12 08:00:45 2006
@@ -1,0 +1,66 @@
+#!/usr/bin/make -f
+# This debian/rules file is provided as a template for normal perl
+# packages. It was created by Marc Brockschmidt <marc at dch-faq.de> for
+# the Debian Perl Group (http://pkg-perl.alioth.debian.org/) but may
+# be used freely wherever it is useful.
+
+# Uncomment this to turn on verbose mode.
+#export DH_VERBOSE=1
+
+# If set to a true value then MakeMaker's prompt function will
+# always return the default without waiting for user input.
+export PERL_MM_USE_DEFAULT=1
+PACKAGE=$(shell dh_listpackages)
+TMP=$(CURDIR)/debian/$(PACKAGE)
+
+ifndef PERL
+PERL = /usr/bin/perl
+endif
+
+build: build-stamp
+build-stamp:
+ dh_testdir
+ $(PERL) Makefile.PL INSTALLDIRS=vendor
+ $(MAKE) OPTIMIZE="-Wall -O2 -g"
+ touch build-stamp
+
+clean:
+ dh_testdir
+ dh_testroot
+ [ ! -f Makefile ] || $(MAKE) realclean
+ dh_clean build-stamp install-stamp
+
+install: build install-stamp
+install-stamp:
+ dh_testdir
+ dh_testroot
+ dh_clean -k
+ $(MAKE) test
+ $(MAKE) install DESTDIR=$(TMP) PREFIX=/usr
+ install -d $(TMP)/usr/share/doc/$(PACKAGE)
+ mv $(TMP)/usr/share/perl5/Net/Lite/example.pl $(TMP)/usr/share/doc/$(PACKAGE)
+ touch install-stamp
+
+binary-arch:
+# We have nothing to do by default.
+
+binary-indep: build install
+ dh_testdir
+ dh_testroot
+ dh_installdocs README
+ dh_installchangelogs Changes
+ dh_perl
+ dh_link
+ dh_strip
+ dh_compress
+ dh_fixperms
+ dh_installdeb
+ dh_gencontrol
+ dh_md5sums
+ dh_builddeb
+
+source diff:
+ @echo >&2 'source and diff are obsolete - use dpkg-source -b'; false
+
+binary: binary-indep binary-arch
+.PHONY: build clean binary-indep binary-arch binary
Propchange: packages/libnet-lite-ftp-perl/trunk/debian/rules
------------------------------------------------------------------------------
svn:executable = *
Added: packages/libnet-lite-ftp-perl/trunk/example.pl
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-lite-ftp-perl/trunk/example.pl?rev=3705&op=file
==============================================================================
--- packages/libnet-lite-ftp-perl/trunk/example.pl (added)
+++ packages/libnet-lite-ftp-perl/trunk/example.pl Tue Sep 12 08:00:45 2006
@@ -1,0 +1,18 @@
+#!/usr/bin/perl -w
+#
+use lib "./lib";
+use Net::Lite::FTP;
+
+my $tlsftp=Net::Lite::FTP->new();
+$tlsftp->open("ftp.tls.pl","21");
+$tlsftp->user("user");
+$tlsftp->pass("password");
+$tlsftp->list();
+$tlsftp->cwd("pub");
+my $files=$tlsftp->list("*.exe");
+foreach $f (@$files) {
+ print "File: $f\n";
+};
+$tlsftp->get("File.txt");# Will overwrite "File.txt" at local directory
+my $slurped=$tlsftp->slurp("Some.file.txt");# Slurp remote file into scalar.
+print length($slurped)." bytes slurped\n";
Propchange: packages/libnet-lite-ftp-perl/trunk/example.pl
------------------------------------------------------------------------------
svn:executable = *
Added: packages/libnet-lite-ftp-perl/trunk/lib/Net/Lite/FTP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-lite-ftp-perl/trunk/lib/Net/Lite/FTP.pm?rev=3705&op=file
==============================================================================
--- packages/libnet-lite-ftp-perl/trunk/lib/Net/Lite/FTP.pm (added)
+++ packages/libnet-lite-ftp-perl/trunk/lib/Net/Lite/FTP.pm Tue Sep 12 08:00:45 2006
@@ -1,0 +1,504 @@
+package Net::Lite::FTP;
+
+
+use 5.006000;
+use strict;
+use warnings;
+use IO::Handle;
+
+require Exporter;
+use AutoLoader qw(AUTOLOAD);
+
+our @ISA = qw(Exporter);
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+
+# This allows declaration use Net::Lite::FTP ':all';
+# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
+# will save memory.
+our %EXPORT_TAGS = ( 'all' => [ qw(
+
+ ) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw(
+
+ );
+
+our $VERSION = '0.47';
+# Preloaded methods go here.
+# Autoload methods go after =cut, and are processed by the autosplit program.
+use constant BUFSIZE => 4096;
+BEGIN {
+ use Net::SSLeay::Handle qw/shutdown/;
+# You only need this if your FTP server requires client certs:
+#Net::SSLeay::Handle::_set_cert("/home/eyck/my.pem");
+#Net::SSLeay::Handle::_set_key("/home/eyck/my.pem");
+# but if you want this, you need to patch you Net::SSLeay,
+};
+
+sub new($$) {
+ my $class=shift;
+ my $self={};
+ bless $self,$class;
+# $self->{'DBHandle'}=$dbh;
+ $self->{"CreationTime"}=time;
+ $self->{"Connected"}=0;
+ $self->{"EncryptData"}=1;
+ $self->{"Encrypt"}=1;
+ $self->{"Debug"}=1;
+ $self->{"ErrMSG"}=undef;
+ $self->{"GetUpdateCallback"} = undef;
+ $self->{"GetDoneCallback"} = undef;
+ $self->{"PutUpdateCallback"} = undef;
+ $self->{"PutDoneCallback"} = undef;
+ return $self;
+};
+
+sub user($$) {
+ my ($self,$user)=@_;
+ $self->command("USER $user");
+}
+sub pass($$) {
+ my ($self,$pass)=@_;
+ $self->command("PASS $pass");
+}
+sub login($$$) {
+ my ($self,$user,$pass)=@_;
+ $self->command("USER $user");
+ $self->command("PASS $pass");
+}
+
+sub cwd ($$) {
+ my ($self,$data)=@_;
+ $self->command("CWD $data");
+}
+
+sub size ($$) {
+ my ($self,$filename)=@_;
+ return $self->command("SIZE $filename");
+}
+sub cdup ($$) {
+ my ($self,$data)=@_;
+ $self->command("CDUP");
+}
+sub dele {
+ my ($self,$pathname)=@_;
+ return undef unless defined($pathname);
+ $self->command("DELE $pathname");
+}
+sub rm {dele(@_);};
+sub delete {dele(@_);};
+sub del { shift->del(@_) };
+
+sub rawmessage ($) {
+ my ($self)=@_;
+ return $self->{'FTPRAWMSG'};
+};
+sub message ($) {
+ my ($self)=@_;
+ return $self->{'FTPMSG'};
+};
+sub msgcode ($) {
+ my ($self)=@_;
+ return $self->{'FTPCODE'};
+};
+
+sub open($$$) {
+ my ($self,$host,$port)=@_;
+ my ($data);
+ my $sock;
+ $sock = Net::SSLeay::Handle->make_socket($host, $port);
+ $self->{'Sock'}=$sock;
+ $self->{'Host'}=$host;
+ $self->{'Port'}=$port;
+ if (sysread($sock,$data,BUFSIZE)) {
+ print STDERR "OPEN.Received: $data" if $self->{Debug};
+ $data=$self->responserest($data);
+ print STDERR "OPEN..Received: $data" if $self->{Debug};
+ }
+
+ if ($self->{'Encrypt'}) {
+ $data="AUTH TLS\r\n";
+ syswrite($sock,$data);
+ if (sysread($sock,$data,BUFSIZE)) {
+ print STDERR "Received: $data" if $self->{Debug};
+ }
+ }
+ $self->{'RAWSock'}=$sock;
+
+ if ($self->{'Encrypt'}) {
+ #{tie(*S, "Net::SSLeay::Handle", $sock);$sock = \*S;};
+ # Unique glob?
+ {my $io=new IO::Handle; tie(*$io, "Net::SSLeay::Handle", $sock);$sock = \*$io;};
+ }
+ $self->{'Sock'}=$sock;
+ {select($sock);$|=1;select(STDOUT);};#unbuffer socket
+
+ $self->setup_protection();
+
+#
+ return 1;
+}
+
+sub quit {
+ my ($self)=@_;
+ return $self->command("QUIT");
+}
+sub rename ($$$) {
+ my ($self,$from,$to)=@_;
+#"RNFR plik1"
+#"RNTO plik2"
+ if ($self->command("RNFR $from")) {
+ return $self->command("RNTO $to");
+ } else {return 0;};
+};
+sub mdtm ($$) {
+ my ($self,$file)=@_;
+ return $self->command("MDTM $file");
+};
+
+sub command ($$){
+ my ($self,$data)=@_;
+ print STDERR "Sending: ",$data."\n" if $self->{Debug};
+ my $sock=$self->{'Sock'};
+ print $sock $data."\r\n";
+ return $self->response();
+}
+
+sub response ($) {
+ my ($self)=@_;
+ my $sock=$self->{'Sock'};
+ my ($read,$resp,$code,$cont);
+ $read=($resp=<$sock>);
+ if (!defined($read)) {
+ warn "Damn! undefined response (err:$!) {H: ".$self->{'Host'}." P:".$self->{'Port'}."}\n";# unless defined($read);
+ $self->{'FTPCODE'}=undef;
+ $self->{'FTPMSG'}=undef;
+ $self->{'FTPRAWMSG'}=undef;
+ return undef;# unless defined($read);
+ };
+ return $self->responserest($read);
+}
+
+sub responserest ($$) {
+ my ($self,$read)=@_;
+ my $sock=$self->{'Sock'};
+ my ($resp,$code,$cont,$msg);
+ $resp=$read;
+#UWAGA!
+# wcale nieprawda to co nizej pisze. Jesli pierwsza linijka to \d\d\d-
+# to odbierac linijki az do napotkania \d\d\d\s
+# np:
+# 226-EDI processing started
+# 01 costam...
+# 02 costam..
+# 226 ...EDI processing complete
+
+
+# Responsy maja format \d\d\d
+# lub wielolinijkowe: \d\d\d-
+ print STDERR "SRV Response: $read" if $self->{Debug};
+ $read=~/^(\d\d\d)\s(.*)/ && do {
+ $code=$1;$msg=$2;chomp($msg);
+ };
+ $read=~/^(\d\d\d)-(.*)/ && do {
+ $cont=1;$msg.=$2;
+ print STDERR "wielolinijkowa odpowiedz z servera.." if $self->{Debug};
+ };
+ if ($read=~/^(\d\d\d)\s(.*)/m) {$cont=0;}; # wyjatek na wielolinijkowe na dziendobry
+ if ($cont) {
+ do {
+ $read=<$sock>;
+ $resp.=$read;
+ $read=~/^(\d\d\d)-(.*)/ && do {$cont=1;$msg.=$2;};
+ $read=~/^(\d\d\d)\s(.*)/ && do {$cont=0;$msg.=$2;};
+ print " ----> $read\n" if $self->{Debug};
+ } until ($cont=0);
+ };
+ $self->{'FTPCODE'}=$code;
+ $self->{'FTPMSG'}=$msg;
+ #$resp=~s/^\d\d\d\s/;
+ $self->{'FTPRAWMSG'}=$resp;
+
+ if ($code>399) {
+#warn "Jaki¶ problem, chyba najlepiej sie wycofac\n";
+#warn $resp;
+# print STDERR "ERR: $resp\n";
+#warn "Server said we're bad.";
+ $self->{'ErrMSG'}=$resp;
+ return undef;
+ };
+ print STDERR "RECV: ",$resp if $self->{Debug};
+ return $msg;
+}
+
+sub list {return nlst(@_);};
+sub nlst {
+ my ($self,$mask)=@_;
+ my $sock=$self->{'Sock'};
+ my $socket;
+ my (@files)=();
+ $socket=$self->datasocket();
+ if (defined($socket)) {
+ my $response;
+ if (defined($mask)) {
+ $response=$self->command("NLST $mask");
+ } else {
+ $response=$self->command("NLST");
+ };
+#print STDERR "ReSPONSE: -> : $response\n";
+ #print "KOD : ",$self->{'FTPCODE'},"\n";
+ # 1xx - cos jeszcze bedzie
+ # 2xx - to juz koniec
+ if ($response && ($self->{'FTPCODE'}<200) ) {
+
+ if ($self->{"EncryptData"}==1) {
+ {my $io=new IO::Handle; tie(*$io, "Net::SSLeay::Handle", $socket);$socket = \*$io;};
+ print STDERR "SSL for data connection enabled...\n" if $self->{Debug};
+ };
+ my $tmp;
+ while ($tmp=<$socket>) {
+#print STDERR "G: $q";
+#chop($tmp);chop($tmp);#\r\n -> remove.
+ $tmp=~s/\r\n$//;
+ push @files,$tmp;
+ };
+ };
+ close $socket;
+ if ($response && ($self->{'FTPCODE'}<200) ) {if ($response) {$response=$self->response();};}
+ print STDERR "resp(end LIST) ",$response if $self->{Debug};
+ return \@files if $response;
+ };
+ return 0;
+};
+
+sub putblat {
+ my ($putorblat,$stororappe,$self,$remote,$local)=@_;
+ my $socket;
+ my $sock=$self->{'Sock'};
+ $local=$remote unless defined($local);
+ $self->command("TYPE I");
+ $socket=$self->datasocket();
+ die "SOCKET NOT CONNECTED! $!\n" unless defined($socket);
+ if ($self->{"EncryptData"}!=0) {$self->command("PROT P"); };
+ my $r=$self->command("$stororappe $remote");
+ if (!$r) {
+ print STDERR "Problem trying to put file" if $self->{Debug};
+ return $r;
+ };
+
+ if ($self->{"EncryptData"}==1) {
+ {my $io=new IO::Handle; tie(*$io, "Net::SSLeay::Handle", $socket);$socket = \*$io;};
+ print STDERR "SSL for data connection enabled...\n" if $self->{Debug};
+ };
+
+ print STDERR "$stororappe connection opened.\n" if $self->{Debug};
+ select($socket);
+#print "selected.\n";
+ if ($putorblat=~/put/) {
+ CORE::open(L,"$local") or die "Can't open file $local, $!";
+ binmode L;
+ my $tmp;
+ while ($tmp=<L>) {
+ print $tmp;
+ if (defined ($self->{'PutUpdateCallback'})) {$self->{'PutUpdateCallback'}->(); };#TODO send sth..
+ };#Probably syswrite/sysread would be smarter..
+ close L;
+ } else {
+ print $local;
+
+ }
+#print "after write...\n";
+ select(STDOUT);
+ close $socket;
+ my $response=$self->response();
+ print STDERR "resp(after$stororappe) ",$response if $self->{Debug};
+ if (defined $self->{'PutDoneCallBack'}) {$self->{'PutDoneCallBack'}->($response);};
+};
+sub put {
+ putblat('put','STOR', at _);
+};
+sub blat {
+ putblat('blat','STOR', at _);
+};
+sub appe {
+ putblat('put','APPE', at _);
+};
+sub blatappe {
+ putblat('blat','APPE', at _);
+};
+
+sub get {
+ getslurp('get', at _);
+};
+sub slurp {
+ getslurp('slurp', at _);
+};
+
+sub getslurp {
+ my ($getorslurp,$self,$remote,$local)=@_;
+ my $socket;
+ my $sock=$self->{'Sock'};
+ $local=$remote unless defined($local);
+ $self->command("TYPE I");
+ $socket=$self->datasocket();
+ if ($self->{"EncryptData"}!=0) {$self->command("PROT P"); };
+ my $r=$self->command("RETR $remote");
+ if (!$r) {
+ print STDERR "Problem trying to get file($remote)" if $self->{Debug};
+ return $r;
+ };
+
+ if ($self->{"EncryptData"}==1) {
+ {my $io=new IO::Handle; tie(*$io, "Net::SSLeay::Handle", $socket);$socket = \*$io;};
+ print STDERR "SSL for data connection(RETR) enabled...\n" if $self->{Debug};
+ };
+ my $slurped="";
+ if ($getorslurp=~/get/) {
+ print STDERR "getorslurp: get\n" if $self->{Debug};
+ CORE::open(L,">$local") or die("Can't open file for writing $local, $!");
+ binmode L;
+ # TODO replace while <$socket> with
+ # TODO while sysread($sock,$tmp,BUFSIZE);
+ my $tmp;
+ while ($tmp=<$socket>) {
+ print L $tmp; print STDERR ":;" if $self->{Debug};
+ if (defined ($self->{'GetUpdateCallback'})) {$self->{'GetUpdateCallback'}->(); };#TODO send sth..
+ };
+ close L;
+ } else {
+ print STDERR "getorslurp: slurp($getorslurp)\n" if $self->{Debug};
+ my $tmp;
+ while ($tmp=<$socket>) {
+ $slurped.=$tmp;print STDERR ":." if $self->{Debug};
+ if (defined ($self->{'GetUpdateCallback'})) {$self->{'GetUpdateCallback'}->(); };#TODO send sth..
+ };
+ };
+ close $socket;
+ my $response=$self->response();
+ print STDERR "resp(afterRETR) ",$response if $self->{Debug};
+ if (defined $self->{'GetDoneCallBack'}) {$self->{'GetDoneCallBack'}->($response);};
+ return $slurped;
+};
+
+sub datasocket {
+ my ($self)=@_;
+ my ($tmp,$socket);
+ if ($tmp=$self->command("PASV")) {
+ if ($self->msgcode()==227 && $tmp=~/[^\d]*(\d+),(\d+),(\d+),(\d+),(\d+),(\d+)/) {
+ my $port=$5*256+$6;
+ my $host="$1.$2.$3.$4";
+ $socket = Net::SSLeay::Handle->make_socket($host, $port);
+ if (defined($socket)) {
+ print STDERR "Data link connected.. to $host at $port\n" if $self->{Debug};
+ } else {
+ warn "Data link NOT connected ($host,$port) $!";
+ die "Data link NOT connected ($host,$port) $!";
+ };
+ } else {
+ die "Problem parsing PASV response($tmp)";
+ };
+ } else {
+ warn "undefined response to PASV cmd (err:$!) {H: ".$self->{'Host'}." P:".$self->{'Port'}."}\n";# unless defined($read);
+ die "Problem sending PASV request, $tmp";
+ };# end if self -> command PASV
+ return $socket
+};
+
+sub trivialm {
+ my ($self)=@_;
+ return 1;
+};
+
+# extras...
+#
+sub registerGetUpdateCallback {
+ my ($self,$callback_ref)=@_;
+
+ $self->{'GetUpdateCallback'} = $callback_ref;
+}
+sub registerGetDoneCallback {
+ my ($self,$callback_ref)=@_;
+
+ $self->{'GetDoneCallback'} = $callback_ref;
+}
+sub registerPutUpdateCallback {
+ my ($self,$callback_ref)=@_;
+
+ $self->{'PutUpdateCallback'} = $callback_ref;
+}
+sub registerPutDoneCallback {
+ my ($self,$callback_ref)=@_;
+
+ $self->{'PutDoneCallback'} = $callback_ref;
+}
+
+sub setup_protection {
+ my ($self)=@_;
+ if ($self->{'Encrypt'}) {
+ $self->command("PBSZ 0");# TODO
+ if ($self->{"EncryptData"}!=0) {$self->command("PROT P"); };
+ } else {return 1;};
+};
+
+
+
+1;
+__END__
+# Below is stub documentation for your module. You'd better edit it!
+
+=head1 NAME
+
+Net::Lite::FTP - Perl FTP client with support for TLS
+
+=head1 SYNOPSIS
+
+ use Net::Lite::FTP;
+ my $tlsftp=Net::Lite::FTP->new();
+ $tlsftp->open("ftp.tls.pl","21");
+ $tlsftp->user("user");
+ $tlsftp->pass("password");
+ $tlsftp->cwd("pub");
+ my $files=$tlsftp->nlst("*.exe");
+ foreach $f (@files) {
+ $tlsftp->get($f);
+ };
+
+
+=head1 DESCRIPTION
+
+Very simple FTP client with support for TLS
+
+=head1 SEE ALSO
+
+L<Net::FTP>
+L<Tie::FTP>
+
+ftp(1), ftpd(8), RFC 959
+http://war.jgaa.com/ftp/rfc/rfc959.txt
+
+http://war.jgaa.com/ftp/draft/draft-murray-auth-ftp-ssl-03.txt
+
+http://www.ietf.org/internet-drafts/draft-murray-auth-ftp-ssl-10.txt
+
+ftp://ftp.ietf.org/internet-drafts/draft-fordh-ftp-ssl-firewall-01.txt
+
+
+=head1 AUTHOR
+
+Dariush Pietrzak,'Eyck' E<lt>cpan at ghost.anime.plE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2005 by Dariush Pietrzak
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.4 or,
+ at your option, any later version of Perl 5 you may have available.
+
+
+=cut
+
Added: packages/libnet-lite-ftp-perl/trunk/t/Net-Lite-FTP.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-lite-ftp-perl/trunk/t/Net-Lite-FTP.t?rev=3705&op=file
==============================================================================
--- packages/libnet-lite-ftp-perl/trunk/t/Net-Lite-FTP.t (added)
+++ packages/libnet-lite-ftp-perl/trunk/t/Net-Lite-FTP.t Tue Sep 12 08:00:45 2006
@@ -1,0 +1,21 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl Net-Lite-FTP.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 3;
+BEGIN { use_ok('Net::Lite::FTP') };
+
+my $obj = Net::Lite::FTP->new;
+isa_ok( $obj, 'Net::Lite::FTP',"Clasa obiektu" );
+is ( $obj->trivialm(), 1, "Trivial method");
+
+
+
+#########################
+
+# Insert your test code below, the Test::More module is use()ed here so read
+# its man page ( perldoc Test::More ) for help writing this test script.
+
More information about the Pkg-perl-cvs-commits
mailing list