1
# LSB Test Execution Framework
2
# FTP Routines Module (Ftp.pm)
4
# Copyright (C) 2007-2009 The Linux Foundation. All rights reserved.
6
# This program has been developed by ISP RAS for LF.
7
# The ptyshell tool is originally written by Jiri Dluhos <jdluhos@suse.cz>
8
# Copyright (C) 2005-2007 SuSE Linux Products GmbH
10
# This program is free software; you can redistribute it and/or
11
# modify it under the terms of the GNU General Public License
12
# version 2 as published by the Free Software Foundation.
14
# This program is distributed in the hope that it will be useful,
15
# but WITHOUT ANY WARRANTY; without even the implied warranty of
16
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17
# GNU General Public License for more details.
19
# You should have received a copy of the GNU General Public License
20
# along with this program; if not, write to the Free Software
21
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
22
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
30
our $list_refresh = 0;
31
#----------------------------------------------------------------------
36
# Check FTP perl module
37
if( system ("perl -MNet::FTP -e 1 >/dev/null 2>&1") != 0) {
38
die "Perl module Net::FTP is required.";
44
print STDERR "FTP init... $srv\n";
45
$ftp = Net::FTP->new($srv, Debug => 0, Passive => 1)
46
or die "FTP init failed. Message: $@";
49
print STDERR "FTP log in... $srv\n";
51
or die "FTP log in (anonymous) failed. Message: ".$ftp->message;
55
#------------------------------------------------------------------------
57
# Reads FTP listing from a file.
58
sub read_listing_from_file {
61
my @listing = (); #result;
64
or die "Can't open file '$filename': $!";
69
if ( /^#TIMESTAMP:(\d{2})-(\d{2})-(\d{4})\s+(\d{2}):(\d{2})$/ ) {
70
# Timestamp helps to determine when the cache expires.
71
my $timestamp = mktime(0, $5, $4, $1, $2-1, $3-1900);
74
elsif ( /^#PWD:(.*)$/ ) {
76
# One could check the path here
79
print STDERR "Wrong syntax in file $filename\n";
83
# It is a regular DIR line
91
#------------------------------------------------------------------------
93
# Returns file listing of a given dir on the ftp server.
95
my ($srv, $dir, $cache_dir) = @_;
96
# $srv - e.g. "ftp.linuxfoundation.org"
97
# $dir - what directory should be listed
99
my @ftp_files = (); # results: @ftp_files[] -> ($filename, $filesize)
103
unless ( -d $cache_dir ) {
104
(system("mkdir -p '$cache_dir'") == 0 )
105
or die "Failed to create the cache directory: '$cache_dir'";
108
print STDERR "> SRC $dir\n";
110
my $ftp_list_file = "$cache_dir/ftp_list";
111
unless( $list_refresh ) {
112
# Read cached listing
113
if ( -f $ftp_list_file ) {
114
$listing = read_listing_from_file( $ftp_list_file );
118
# Refresh the listing.
119
( $ftp ) or login_ftp( $srv );
121
$listing = $ftp->dir($dir);
125
print STDERR "WRONG DIR\n";
131
if ( $list_refresh || !-f $ftp_list_file ) {
132
my ($sec, $min, $hour, $mday, $mon, $year) = localtime ();
133
open LISTFILE, "> $ftp_list_file"
134
or die "Failed to open file '$ftp_list_file' for writing: $!";
137
.sprintf ("%02d-%02d-%04d %02d:%02d\n", $mday, ($mon + 1),
138
($year + 1900), $hour, $min )
140
.(join "\n", @$listing)
146
print STDERR "< Empty\n";
151
# Parse ftp files listing
152
foreach my $line (@$listing) {
153
# -rwxr-xr-x 1 user group size date time filename.ext
154
if($line =~ m/^(\S+)\s+\S+\s+\S+\s+\S+\s+(\S+)\s+\S+\s+\S+\s+\S+\s+(\S+)/) {
159
# If it is an ordinary file or a symlink
160
if($attrs =~ /^[-l]/ ) {
161
$filesize = 0 if $attrs =~ /^l/; # Set the size undefined if this is a symlink
162
my @line = ($filename, $filesize);
163
push @ftp_files, \@line;
167
print STDERR "Wrong syntax in ftp listing: $line\n";
170
print STDERR "< Ok\n";
176
#----------------------------------------------------------------------------
added
removed
utils/Ftp.pm
