dpkg-1.16.1.1/dselect/methods/Debian/Dselect/Ftp.pm - nest-learning-thermostat/5.1/dpkg - Git at Google

 # -*-perl-*-

 use Net::FTP;
 use Exporter;
 use Data::Dumper;

 use strict;
 use vars qw(@EXPORT %config $VAR1);

 @EXPORT = qw(yesno do_connect do_mdtm add_site edit_site
              edit_config read_config store_config view_mirrors nb);

 sub nb {
   my $nb = shift;
   if ($nb > 1024**2) {
     return sprintf("%.2fM", $nb / 1024**2);
   } elsif ($nb > 1024) {
     return sprintf("%.2fk", $nb / 1024);
   } else {
     return sprintf("%.2fb", $nb);
   }

 }

 sub read_config {
   my $vars = shift;
   my ($code, $conf);

   local($/);
   open(VARS, $vars) || die "Couldn't open $vars : $!\nTry to relaunch the 'Access' step in dselect, thanks.\n";
   $code = <VARS>;
   close VARS;

   $conf = eval $code;
   die "Couldn't eval $vars content : $@\n" if ($@);
   if (ref($conf) =~ /HASH/) {
     foreach (keys %{$conf}) {
       $config{$_} = $conf->{$_};
     }
   } else {
     print "Bad $vars file : removing it.\n";
     print "Please relaunch the 'Access' step in dselect. Thanks.\n";
     unlink $vars;
     exit 0;
   }
 }

 sub store_config {
   my $vars = shift;

   # Check that config is completed
   return if not $config{'done'};

   open(VARS, ">$vars") || die "Couldn't open $vars in write mode : $!\n";
   print VARS Dumper(\%config);
   close VARS;
 }

 sub view_mirrors {
   if (-f '/usr/lib/dpkg/methods/ftp/README.mirrors.txt') {
     system('/usr/bin/pager', '/usr/lib/dpkg/methods/ftp/README.mirrors.txt');
   } elsif (-f '/usr/lib/dpkg/methods/ftp/README.mirrors.txt.gz') {
     system('gzip -dc /usr/lib/dpkg/methods/ftp/README.mirrors.txt.gz | pager');
   } else {
     print "/usr/lib/dpkg/methods/ftp/README.mirrors.txt(.gz): file not found.\n";
   }
 }

 sub edit_config {
   my $methdir = shift;
   my $i;

   #Get a config for ftp sites
   while(1) {
     $i = 1;
     print "\n\nList of selected ftp sites :\n";
     foreach (@{$config{'site'}}) {
       print "$i. ftp://$_->[0]$_->[1] @{$_->[2]}\n";
       $i++;
     }
     print "\nEnter a command (a=add e=edit d=delete q=quit m=mirror list) \n";
     print "eventually followed by a site number : ";
     chomp($_ = <STDIN>);
     /q/i && last;
     /a/i && add_site();
     /d\s*(\d+)/i &&
     do { splice(@{$config{'site'}}, $1-1, 1) if ($1 <= @{$config{'site'}});
          next;};
     /e\s*(\d+)/i &&
     do { edit_site($config{'site'}[$1-1]) if ($1 <= @{$config{'site'}});
          next; };
     m#m#i && view_mirrors();
   }

   print "\n";
   $config{'use_auth_proxy'} = yesno($config{'use_auth_proxy'} ? "y" : "n",
                                       "Go through an authenticated proxy");

   if ($config{'use_auth_proxy'}) {
     print "\nEnter proxy hostname [$config{'proxyhost'}] : ";
     chomp($_ = <STDIN>);
     $config{'proxyhost'} = $_ || $config{'proxyhost'};

     print "\nEnter proxy log name [$config{'proxylogname'}] : ";
     chomp($_ = <STDIN>);
     $config{'proxylogname'} = $_ || $config{'proxylogname'};

     print "\nEnter proxy password [$config{'proxypassword'}] : ";
     chomp ($_ = <STDIN>);
     $config{'proxypassword'} = $_ || $config{'proxypassword'};
   }

   print "\nEnter directory to download binary package files to\n";
   print "(relative to $methdir)\n";
   while(1) {
     print "[$config{'dldir'}] : ";
     chomp($_ = <STDIN>);
     s{/$}{};
     $config{'dldir'} = $_ if ($_);
     last if -d "$methdir/$config{'dldir'}";
     print "$methdir/$config{'dldir'} is not a directory !\n";
   }
 }

 sub add_site {
   my $pas = 1;
   my $user = "anonymous";
   my $email = `whoami`;
   chomp $email;
   $email .= '@' . `cat /etc/mailname || dnsdomainname`;
   chomp $email;
   my $dir = "/debian";

   push (@{$config{'site'}}, [ "", $dir, [ "dists/stable/main",
                                           "dists/stable/contrib",
 					  "dists/stable/non-free" ],
                                $pas, $user, $email ]);
   edit_site($config{'site'}[@{$config{'site'}} - 1]);
 }

 sub edit_site {
   my $site = shift;

   local($_);

   print "\nEnter ftp site [$site->[0]] : ";
   chomp($_ = <STDIN>);
   $site->[0] = $_ || $site->[0];

   print "\nUse passive mode [" . ($site->[3] ? "y" : "n") ."] : ";
   chomp($_ = <STDIN>);
   $site->[3] = (/y/i ? 1 : 0) if ($_);

   print "\nEnter username [$site->[4]] : ";
   chomp($_ = <STDIN>);
   $site->[4] = $_ || $site->[4];

   print <<EOF;

 If you're using anonymous ftp to retrieve files, enter your email
 address for use as a password. Otherwise enter your password,
 or "?" if you want dselect-ftp to prompt you each time.

 EOF

   print "Enter password [$site->[5]] : ";
   chomp($_ = <STDIN>);
   $site->[5] = $_ || $site->[5];

   print "\nEnter debian directory [$site->[1]] : ";
   chomp($_ = <STDIN>);
   $site->[1] = $_ || $site->[1];

   print "\nEnter space separated list of distributions to get\n";
   print "[@{$site->[2]}] : ";
   chomp($_ = <STDIN>);
   $site->[2] = [ split(/\s+/) ] if $_;
 }

 sub yesno($$) {
   my ($d, $msg) = @_;

   my ($res, $r);
   $r = -1;
   $r = 0 if $d eq "n";
   $r = 1 if $d eq "y";
   die "Incorrect usage of yesno, stopped" if $r == -1;
   while (1) {
     print $msg, " [$d]: ";
     $res = <STDIN>;
     $res =~ /^[Yy]/ and return 1;
     $res =~ /^[Nn]/ and return 0;
     $res =~ /^[ \t]*$/ and return $r;
     print "Please enter one of the letters `y' or `n'\n";
   }
 }

 ##############################

 sub do_connect {
     my($ftpsite,$username,$pass,$ftpdir,$passive,
        $useproxy,$proxyhost,$proxylogname,$proxypassword) = @_;

     my($rpass,$remotehost,$remoteuser,$ftp);

   TRY_CONNECT:
     while(1) {
 	my $exit = 0;

 	if ($useproxy) {
 	    $remotehost = $proxyhost;
 	    $remoteuser = $username . "@" . $ftpsite;
 	} else {
 	    $remotehost = $ftpsite;
 	    $remoteuser = $username;
 	}
 	print "Connecting to $ftpsite...\n";
 	$ftp = Net::FTP->new($remotehost, Passive => $passive);
 	if(!$ftp || !$ftp->ok) {
 	  print "Failed to connect\n";
 	  $exit=1;
 	}
 	if (!$exit) {
 #    $ftp->debug(1);
 	    if ($useproxy) {
 		print "Login on $proxyhost...\n";
 		$ftp->_USER($proxylogname);
 		$ftp->_PASS($proxypassword);
 	    }
 	    print "Login as $username...\n";
 	    if ($pass eq "?") {
 		    print "Enter password for ftp: ";
 		    system("stty", "-echo");
 		    $rpass = <STDIN>;
 		    chomp $rpass;
 		    print "\n";
 		    system("stty", "echo");
 	    } else {
 		    $rpass = $pass;
 	    }
 	    if(!$ftp->login($remoteuser, $rpass))
 	    { print $ftp->message() . "\n"; $exit=1; }
 	}
 	if (!$exit) {
 	    print "Setting transfer mode to binary...\n";
 	    if(!$ftp->binary()) { print $ftp->message . "\n"; $exit=1; }
 	}
 	if (!$exit) {
 	    print "Cd to `$ftpdir'...\n";
 	    if(!$ftp->cwd($ftpdir)) { print $ftp->message . "\n"; $exit=1; }
 	}

 	if ($exit) {
 	    if (yesno ("y", "Retry connection at once")) {
 		next TRY_CONNECT;
 	    } else {
 		die "error";
 	    }
 	}

 	last TRY_CONNECT;
     }

 #    if(!$ftp->pasv()) { print $ftp->message . "\n"; die "error"; }

     return $ftp;
 }

 ##############################

 # assume server supports MDTM - will be adjusted if needed
 my $has_mdtm = 1;

 my %months = ('Jan', 0,
 	      'Feb', 1,
 	      'Mar', 2,
 	      'Apr', 3,
 	      'May', 4,
 	      'Jun', 5,
 	      'Jul', 6,
 	      'Aug', 7,
 	      'Sep', 8,
 	      'Oct', 9,
 	      'Nov', 10,
 	      'Dec', 11);

 sub do_mdtm {
     my ($ftp, $file) = @_;
     my ($time);

     #if ($has_mdtm) {
 	$time = $ftp->mdtm($file);
 #	my $code=$ftp->code();	my $message=$ftp->message();
 #	print " [ $code: $message ] ";
 	if ($ftp->code() == 502		      # MDTM not implemented
 	    || $ftp->code() == 500	      # command not understood (SUN firewall)
 	    ) {
 	    $has_mdtm = 0;
 	} elsif (!$ftp->ok()) {
 	    return undef;
 	}
     #}

     if (! $has_mdtm) {
 	use Time::Local;

 	my @files = $ftp->dir($file);
 	if (($#files == -1) || ($ftp->code == 550)) { # No such file or directory
 	    return undef;
 	}

 #	my $code=$ftp->code();	my $message=$ftp->message();
 #	print " [ $code: $message ] ";

 #	print "[$#files]";

 	# get the date components from the output of "ls -l"
 	if ($files[0] =~
 	    /([^ ]+ *){5}[^ ]+ ([A-Z][a-z]{2}) ([ 0-9][0-9]) ([0-9 ][0-9][:0-9][0-9]{2})/) {

             my($month_name, $day, $yearOrTime, $month, $hours, $minutes,
 	       $year);

 	    # what we can read
 	    $month_name = $2;
 	    $day = 0 + $3;
 	    $yearOrTime = $4;

 	    # translate the month name into number
 	    $month = $months{$month_name};

 	    # recognize time or year, and compute missing one
 	    if ($yearOrTime =~ /([0-9]{2}):([0-9]{2})/) {
 		$hours = 0 + $1; $minutes = 0 + $2;
 		my @this_date = gmtime(time());
 		my $this_month = $this_date[4];
 		my $this_year = $this_date[5];
 		if ($month > $this_month) {
 		    $year = $this_year - 1;
 		} else {
 		    $year = $this_year;
 		}
 	    } elsif ($yearOrTime =~ / [0-9]{4}/) {
 		$hours = 0; $minutes = 0;
 		$year = $yearOrTime - 1900;
 	    } else {
 		die "Cannot parse year-or-time";
 	    }

 	    # build a system time
 	    $time = timegm (0, $minutes, $hours, $day, $month, $year);
 	} else {
 	    die "Regexp match failed on LIST output";
 	}
     }

     return $time;
 }

 1;

 __END__
	# --perl--

	use Net::FTP;
	use Exporter;
	use Data::Dumper;

	use strict;
	use vars qw(@EXPORT %config $VAR1);

	@EXPORT = qw(yesno do_connect do_mdtm add_site edit_site
	edit_config read_config store_config view_mirrors nb);

	sub nb {
	my $nb = shift;
	if ($nb > 1024**2) {
	return sprintf("%.2fM", $nb / 1024**2);
	} elsif ($nb > 1024) {
	return sprintf("%.2fk", $nb / 1024);
	} else {
	return sprintf("%.2fb", $nb);
	}

	}

	sub read_config {
	my $vars = shift;
	my ($code, $conf);

	local($/);
	open(VARS, $vars) \|\| die "Couldn't open $vars : $!\nTry to relaunch the 'Access' step in dselect, thanks.\n";
	$code = <VARS>;
	close VARS;

	$conf = eval $code;
	die "Couldn't eval $vars content : $@\n" if ($@);
	if (ref($conf) =~ /HASH/) {
	foreach (keys %{$conf}) {
	$config{$_} = $conf->{$_};
	}
	} else {
	print "Bad $vars file : removing it.\n";
	print "Please relaunch the 'Access' step in dselect. Thanks.\n";
	unlink $vars;
	exit 0;
	}
	}

	sub store_config {
	my $vars = shift;

	# Check that config is completed
	return if not $config{'done'};

	open(VARS, ">$vars") \|\| die "Couldn't open $vars in write mode : $!\n";
	print VARS Dumper(\%config);
	close VARS;
	}

	sub view_mirrors {
	if (-f '/usr/lib/dpkg/methods/ftp/README.mirrors.txt') {
	system('/usr/bin/pager', '/usr/lib/dpkg/methods/ftp/README.mirrors.txt');
	} elsif (-f '/usr/lib/dpkg/methods/ftp/README.mirrors.txt.gz') {
	system('gzip -dc /usr/lib/dpkg/methods/ftp/README.mirrors.txt.gz \| pager');
	} else {
	print "/usr/lib/dpkg/methods/ftp/README.mirrors.txt(.gz): file not found.\n";
	}
	}

	sub edit_config {
	my $methdir = shift;
	my $i;

	#Get a config for ftp sites
	while(1) {
	$i = 1;
	print "\n\nList of selected ftp sites :\n";
	foreach (@{$config{'site'}}) {
	print "$i. ftp://$_->[0]$_->[1] @{$_->[2]}\n";
	$i++;
	}
	print "\nEnter a command (a=add e=edit d=delete q=quit m=mirror list) \n";
	print "eventually followed by a site number : ";
	chomp($_ = <STDIN>);
	/q/i && last;
	/a/i && add_site();
	/d\s*(\d+)/i &&
	do { splice(@{$config{'site'}}, $1-1, 1) if ($1 <= @{$config{'site'}});
	next;};
	/e\s*(\d+)/i &&
	do { edit_site($config{'site'}[$1-1]) if ($1 <= @{$config{'site'}});
	next; };
	m#m#i && view_mirrors();
	}

	print "\n";
	$config{'use_auth_proxy'} = yesno($config{'use_auth_proxy'} ? "y" : "n",
	"Go through an authenticated proxy");

	if ($config{'use_auth_proxy'}) {
	print "\nEnter proxy hostname [$config{'proxyhost'}] : ";
	chomp($_ = <STDIN>);
	$config{'proxyhost'} = $_ \|\| $config{'proxyhost'};

	print "\nEnter proxy log name [$config{'proxylogname'}] : ";
	chomp($_ = <STDIN>);
	$config{'proxylogname'} = $_ \|\| $config{'proxylogname'};

	print "\nEnter proxy password [$config{'proxypassword'}] : ";
	chomp ($_ = <STDIN>);
	$config{'proxypassword'} = $_ \|\| $config{'proxypassword'};
	}

	print "\nEnter directory to download binary package files to\n";
	print "(relative to $methdir)\n";
	while(1) {
	print "[$config{'dldir'}] : ";
	chomp($_ = <STDIN>);
	s{/$}{};
	$config{'dldir'} = $_ if ($_);
	last if -d "$methdir/$config{'dldir'}";
	print "$methdir/$config{'dldir'} is not a directory !\n";
	}
	}

	sub add_site {
	my $pas = 1;
	my $user = "anonymous";
	my $email = `whoami`;
	chomp $email;
	$email .= '@' . `cat /etc/mailname \|\| dnsdomainname`;
	chomp $email;
	my $dir = "/debian";

	push (@{$config{'site'}}, [ "", $dir, [ "dists/stable/main",
	"dists/stable/contrib",
	"dists/stable/non-free" ],
	$pas, $user, $email ]);
	edit_site($config{'site'}[@{$config{'site'}} - 1]);
	}

	sub edit_site {
	my $site = shift;

	local($_);

	print "\nEnter ftp site [$site->[0]] : ";
	chomp($_ = <STDIN>);
	$site->[0] = $_ \|\| $site->[0];

	print "\nUse passive mode [" . ($site->[3] ? "y" : "n") ."] : ";
	chomp($_ = <STDIN>);
	$site->[3] = (/y/i ? 1 : 0) if ($_);

	print "\nEnter username [$site->[4]] : ";
	chomp($_ = <STDIN>);
	$site->[4] = $_ \|\| $site->[4];

	print <<EOF;

	If you're using anonymous ftp to retrieve files, enter your email
	address for use as a password. Otherwise enter your password,
	or "?" if you want dselect-ftp to prompt you each time.

	EOF

	print "Enter password [$site->[5]] : ";
	chomp($_ = <STDIN>);
	$site->[5] = $_ \|\| $site->[5];

	print "\nEnter debian directory [$site->[1]] : ";
	chomp($_ = <STDIN>);
	$site->[1] = $_ \|\| $site->[1];

	print "\nEnter space separated list of distributions to get\n";
	print "[@{$site->[2]}] : ";
	chomp($_ = <STDIN>);
	$site->[2] = [ split(/\s+/) ] if $_;
	}

	sub yesno($$) {
	my ($d, $msg) = @_;

	my ($res, $r);
	$r = -1;
	$r = 0 if $d eq "n";
	$r = 1 if $d eq "y";
	die "Incorrect usage of yesno, stopped" if $r == -1;
	while (1) {
	print $msg, " [$d]: ";
	$res = <STDIN>;
	$res =~ /^[Yy]/ and return 1;
	$res =~ /^[Nn]/ and return 0;
	$res =~ /^[ \t]*$/ and return $r;
	print "Please enter one of the letters `y' or `n'\n";
	}
	}

	##############################

	sub do_connect {
	my($ftpsite,$username,$pass,$ftpdir,$passive,
	$useproxy,$proxyhost,$proxylogname,$proxypassword) = @_;

	my($rpass,$remotehost,$remoteuser,$ftp);

	TRY_CONNECT:
	while(1) {
	my $exit = 0;

	if ($useproxy) {
	$remotehost = $proxyhost;
	$remoteuser = $username . "@" . $ftpsite;
	} else {
	$remotehost = $ftpsite;
	$remoteuser = $username;
	}
	print "Connecting to $ftpsite...\n";
	$ftp = Net::FTP->new($remotehost, Passive => $passive);
	if(!$ftp \|\| !$ftp->ok) {
	print "Failed to connect\n";
	$exit=1;
	}
	if (!$exit) {
	# $ftp->debug(1);
	if ($useproxy) {
	print "Login on $proxyhost...\n";
	$ftp->_USER($proxylogname);
	$ftp->_PASS($proxypassword);
	}
	print "Login as $username...\n";
	if ($pass eq "?") {
	print "Enter password for ftp: ";
	system("stty", "-echo");
	$rpass = <STDIN>;
	chomp $rpass;
	print "\n";
	system("stty", "echo");
	} else {
	$rpass = $pass;
	}
	if(!$ftp->login($remoteuser, $rpass))
	{ print $ftp->message() . "\n"; $exit=1; }
	}
	if (!$exit) {
	print "Setting transfer mode to binary...\n";
	if(!$ftp->binary()) { print $ftp->message . "\n"; $exit=1; }
	}
	if (!$exit) {
	print "Cd to `$ftpdir'...\n";
	if(!$ftp->cwd($ftpdir)) { print $ftp->message . "\n"; $exit=1; }
	}

	if ($exit) {
	if (yesno ("y", "Retry connection at once")) {
	next TRY_CONNECT;
	} else {
	die "error";
	}
	}

	last TRY_CONNECT;
	}

	# if(!$ftp->pasv()) { print $ftp->message . "\n"; die "error"; }

	return $ftp;
	}

	##############################

	# assume server supports MDTM - will be adjusted if needed
	my $has_mdtm = 1;

	my %months = ('Jan', 0,
	'Feb', 1,
	'Mar', 2,
	'Apr', 3,
	'May', 4,
	'Jun', 5,
	'Jul', 6,
	'Aug', 7,
	'Sep', 8,
	'Oct', 9,
	'Nov', 10,
	'Dec', 11);

	sub do_mdtm {
	my ($ftp, $file) = @_;
	my ($time);

	#if ($has_mdtm) {
	$time = $ftp->mdtm($file);
	# my $code=$ftp->code(); my $message=$ftp->message();
	# print " [ $code: $message ] ";
	if ($ftp->code() == 502 # MDTM not implemented
	\|\| $ftp->code() == 500 # command not understood (SUN firewall)
	) {
	$has_mdtm = 0;
	} elsif (!$ftp->ok()) {
	return undef;
	}
	#}

	if (! $has_mdtm) {
	use Time::Local;

	my @files = $ftp->dir($file);
	if (($#files == -1) \|\| ($ftp->code == 550)) { # No such file or directory
	return undef;
	}

	# my $code=$ftp->code(); my $message=$ftp->message();
	# print " [ $code: $message ] ";

	# print "[$#files]";

	# get the date components from the output of "ls -l"
	if ($files[0] =~
	/([^ ]+ *){5}[^ ]+ ([A-Z][a-z]{2}) ([ 0-9][0-9]) ([0-9 ][0-9][:0-9][0-9]{2})/) {

	my($month_name, $day, $yearOrTime, $month, $hours, $minutes,
	$year);

	# what we can read
	$month_name = $2;
	$day = 0 + $3;
	$yearOrTime = $4;

	# translate the month name into number
	$month = $months{$month_name};

	# recognize time or year, and compute missing one
	if ($yearOrTime =~ /([0-9]{2}):([0-9]{2})/) {
	$hours = 0 + $1; $minutes = 0 + $2;
	my @this_date = gmtime(time());
	my $this_month = $this_date[4];
	my $this_year = $this_date[5];
	if ($month > $this_month) {
	$year = $this_year - 1;
	} else {
	$year = $this_year;
	}
	} elsif ($yearOrTime =~ / [0-9]{4}/) {
	$hours = 0; $minutes = 0;
	$year = $yearOrTime - 1900;
	} else {
	die "Cannot parse year-or-time";
	}

	# build a system time
	$time = timegm (0, $minutes, $hours, $day, $month, $year);
	} else {
	die "Regexp match failed on LIST output";
	}
	}

	return $time;
	}

	1;

	__END__