This switches "fetch" to open3 and then croak with the STDERR it gets
back from FTP if there was not STDOUT.
It also adjusts the name used in errors and the User-Agent sent to
remote servers. I wasn't sure what to use for the User-Agent, so went
simple.
This hasn't gotten super heavy testing, even in the CPAN portgen module,
but it should cause obvious fallout. I fixed the one obvious spot where
I knew we expected the file not to exist.
Comments, Suggestions, OK?
Index: lib/OpenBSD/PortGen/Utils.pm
===================================================================
RCS file: /cvs/ports/infrastructure/lib/OpenBSD/PortGen/Utils.pm,v
retrieving revision 1.7
diff -u -p -w -r1.7 Utils.pm
--- lib/OpenBSD/PortGen/Utils.pm 11 Jul 2020 22:26:01 -0000 1.7
+++ lib/OpenBSD/PortGen/Utils.pm 6 Dec 2020 04:17:58 -0000
@@ -22,6 +22,10 @@ use feature qw( state );
use parent qw( Exporter );
+use Carp;
+use IPC::Open3;
+use Symbol 'gensym';
+
our @EXPORT_OK = qw(
add_to_new_ports
base_dir
@@ -36,12 +40,20 @@ sub fetch
{
my $url = shift;
+ my($wtr, $rdr, $err);
+ $err = gensym;
+
for ( 0 .. 1 ) {
- open my $fh, '-|', _fetch_cmd() . " -o- $url 2> /dev/null" or die $!;
- my $content = do { local $/ = undef; <$fh> };
+ my $pid = open3(
+ $wtr, $rdr, $err,
+ _fetch_cmd(), qw< -o- -M -V -N portgen -U >, 'OpenBSD portgen', $url
+ ) or die $!;
+ close $wtr;
+ my $content = do { local $/ = undef; readline $rdr };
return $content if $content;
sleep 2 * $_;
}
+ croak( do { local $/ = undef; readline $err } );
}
sub ports_dir { $ENV{PORTSDIR} || '/usr/ports' }
Index: lib/OpenBSD/PortGen/Port/CPAN.pm
===================================================================
RCS file: /cvs/ports/infrastructure/lib/OpenBSD/PortGen/Port/CPAN.pm,v
retrieving revision 1.8
diff -u -p -w -r1.8 CPAN.pm
--- lib/OpenBSD/PortGen/Port/CPAN.pm 14 May 2019 15:00:01 -0000 1.8
+++ lib/OpenBSD/PortGen/Port/CPAN.pm 6 Dec 2020 04:17:58 -0000
@@ -82,7 +112,9 @@ sub needs_author
$file = "$1/$file" if $file =~ /^(\w+)-/;
- return !fetch("$mirror/modules/by-module/$file");
+ local $@;
+ return !eval { local $SIG{__DIE__};
+ fetch("$mirror/modules/by-module/$file") };
}
sub get_config_style
No comments:
Post a Comment