This is an automated email from the git hooks/post-receive script. guillem pushed a commit to branch main in repository dpkg.
View the commit online: https://git.dpkg.org/cgit/dpkg/dpkg.git/commit/?id=ebf49a807ca8cd8b51c4a5166765777dbdf979d9 commit ebf49a807ca8cd8b51c4a5166765777dbdf979d9 Author: Guillem Jover <guil...@debian.org> AuthorDate: Mon Mar 20 23:50:17 2023 +0100 Dselect::Method: Move to be generic functions from Dselect::Ftp --- dselect/methods/Dselect/Method.pm | 267 ++++++++++++++++++++++++++++++++++ dselect/methods/Dselect/Method/Ftp.pm | 210 +------------------------- dselect/methods/Makefile.am | 1 + dselect/methods/ftp/install.pl | 1 + dselect/methods/ftp/setup.pl | 1 + dselect/methods/ftp/update.pl | 1 + 6 files changed, 272 insertions(+), 209 deletions(-) diff --git a/dselect/methods/Dselect/Method.pm b/dselect/methods/Dselect/Method.pm new file mode 100644 index 000000000..d5fe984f7 --- /dev/null +++ b/dselect/methods/Dselect/Method.pm @@ -0,0 +1,267 @@ +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <https://www.gnu.org/licenses/>. + +=encoding utf8 + +=head1 NAME + +Dselect::Method - dselect method support + +=head1 DESCRIPTION + +This module provides support functions to implement methods. + +B<Note>: This is a private module, its API can change at any time. + +=cut + +package Dselect::Method 0.01; + +use strict; +use warnings; + +our @EXPORT = qw( + %CONFIG + yesno + nb + view_mirrors + add_site + edit_site + edit_config + read_config + store_config +); + +use Exporter qw(import); +use Carp; + +eval q{ + use Data::Dumper; + + use Dpkg::File; +}; +if ($@) { + warn "Missing Dpkg modules required by the access method.\n\n"; + exit 1; +} + +our %CONFIG; + +sub yesno($$) { + my ($d, $msg) = @_; + + my ($res, $r); + $r = -1; + $r = 0 if $d eq 'n'; + $r = 1 if $d eq 'y'; + croak '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 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); + + eval { + $code = file_slurp($vars); + }; + if ($@) { + warn "$@\n"; + die "Try to relaunch the 'Access' step in dselect, thanks.\n"; + } + + my $VAR1; ## no critic (Variables::ProhibitUnusedVariables) + $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}; + + file_dump($vars, Dumper(\%CONFIG)); +} + +sub view_mirrors { + print <<'MIRRORS'; +Please see <https://www.debian.org/mirror/list> for a current +list of Debian mirror sites. +MIRRORS +} + +sub edit_config { + my ($method, $methdir) = @_; + my $i; + + # Get a config for the sites + while (1) { + $i = 1; + print "\n\nList of selected $method sites :\n"; + foreach (@{$CONFIG{site}}) { + print "$i. $method://$_->[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($method); + /d\s*(\d+)/i && do { + splice(@{$CONFIG{site}}, $1 - 1, 1) if $1 <= @{$CONFIG{site}}; + next; + }; + /e\s*(\d+)/i && do { + edit_site($method, $CONFIG{site}[$1 - 1]) if $1 <= @{$CONFIG{site}}; + next; + }; + /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 $method = shift; + + my $pas = 1; + my $user = 'anonymous'; + my $email = qx(whoami); + chomp $email; + $email .= '@' . qx(cat /etc/mailname || dnsdomainname); + chomp $email; + my $dir = '/debian'; + + push @{$CONFIG{site}}, [ + '', + $dir, + [ + 'dists/stable/main', + 'dists/stable/contrib', + 'dists/stable/non-free-firmware', + 'dists/stable/non-free', + ], + $pas, + $user, + $email, + ]; + edit_site($method, $CONFIG{site}[@{$CONFIG{site}} - 1]); +} + +sub edit_site { + my ($method, $site) = @_; + + local $_; + + print "\nEnter $method 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 are using anonymous $method to retrieve files, enter your email +address for use as a password. Otherwise enter your password, +or "?" if you want the $method method 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 $_; +} + +=head1 CHANGES + +=head2 Version 0.xx + +This is a private module. + +=cut + +1; + +__END__ diff --git a/dselect/methods/Dselect/Method/Ftp.pm b/dselect/methods/Dselect/Method/Ftp.pm index 7c080ee6f..b460d0c56 100644 --- a/dselect/methods/Dselect/Method/Ftp.pm +++ b/dselect/methods/Dselect/Method/Ftp.pm @@ -31,17 +31,8 @@ use strict; use warnings; our @EXPORT = qw( - %CONFIG - yesno - nb do_connect do_mdtm - view_mirrors - add_site - edit_site - edit_config - read_config - store_config ); use Exporter qw(import); @@ -50,211 +41,12 @@ use Carp; eval q{ use Net::FTP; use Data::Dumper; - - use Dpkg::File; }; if ($@) { - warn "Missing Dpkg modules required by the FTP access method.\n\n"; + warn "Missing Net::FTP modules required by the FTP access method.\n\n"; exit 1; } -our %CONFIG; - -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); - - eval { - $code = file_slurp($vars); - }; - if ($@) { - warn "$@\n"; - die "Try to relaunch the 'Access' step in dselect, thanks.\n"; - } - - my $VAR1; ## no critic (Variables::ProhibitUnusedVariables) - $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}; - - file_dump($vars, Dumper(\%CONFIG)); -} - -sub view_mirrors { - print <<'MIRRORS'; -Please see <https://www.debian.org/mirror/list> for a current -list of Debian mirror sites. -MIRRORS -} - -sub edit_config { - my ($method, $methdir) = @_; - my $i; - - # Get a config for the sites. - while(1) { - $i = 1; - print "\n\nList of selected $method sites :\n"; - foreach (@{$CONFIG{site}}) { - print "$i. $method://$_->[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($method); - /d\s*(\d+)/i && - do { - splice(@{$CONFIG{site}}, $1 - 1, 1) if ($1 <= @{$CONFIG{site}}); - next;}; - /e\s*(\d+)/i && - do { - edit_site($method, $CONFIG{site}[$1 - 1]) if $1 <= @{$CONFIG{site}}; - next; }; - /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 $method = shift; - - my $pas = 1; - my $user = 'anonymous'; - my $email = qx(whoami); - chomp $email; - $email .= '@' . qx(cat /etc/mailname || dnsdomainname); - chomp $email; - my $dir = '/debian'; - - push (@{$CONFIG{site}}, [ - '', - $dir, - [ - 'dists/stable/main', - 'dists/stable/contrib', - 'dists/stable/non-free-firmware', - 'dists/stable/non-free', - ], - $pas, $user, $email ]); - edit_site($method, $CONFIG{site}[@{$CONFIG{site}} - 1]); -} - -sub edit_site { - my ($method, $site) = @_; - - local($_); - - print "\nEnter $method 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 are using anonymous $method to retrieve files, enter your email -address for use as a password. Otherwise enter your password, -or "?" if you want the $method method 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'; - croak '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 (%opts) = @_; diff --git a/dselect/methods/Makefile.am b/dselect/methods/Makefile.am index 4a87dfdf4..15c9cabc3 100644 --- a/dselect/methods/Makefile.am +++ b/dselect/methods/Makefile.am @@ -25,6 +25,7 @@ nobase_methods_SCRIPTS = \ perllibdir = $(PERL_LIBDIR) nobase_dist_perllib_DATA = \ + Dselect/Method.pm \ Dselect/Method/Ftp.pm \ # EOL diff --git a/dselect/methods/ftp/install.pl b/dselect/methods/ftp/install.pl index e51e0a274..76ed7db7e 100755 --- a/dselect/methods/ftp/install.pl +++ b/dselect/methods/ftp/install.pl @@ -34,6 +34,7 @@ if ($@) { exit 1; } +use Dselect::Method; use Dselect::Method::Ftp; my $ftp; diff --git a/dselect/methods/ftp/setup.pl b/dselect/methods/ftp/setup.pl index de7648c43..b9e8e273f 100755 --- a/dselect/methods/ftp/setup.pl +++ b/dselect/methods/ftp/setup.pl @@ -28,6 +28,7 @@ if ($@) { exit 1; } +use Dselect::Method; use Dselect::Method::Ftp; # deal with arguments diff --git a/dselect/methods/ftp/update.pl b/dselect/methods/ftp/update.pl index a7e166226..8fcd7b140 100755 --- a/dselect/methods/ftp/update.pl +++ b/dselect/methods/ftp/update.pl @@ -28,6 +28,7 @@ if ($@) { exit 1; } +use Dselect::Method; use Dselect::Method::Ftp; # deal with arguments -- Dpkg.Org's dpkg
