On Sun, Dec 08, 2019 at 11:42:50AM -0700, Aaron Bieber wrote:
> Here is a diff that adds go support in portgen(1). It's a combination
> of diffs from my self and afresh1@. There are a few issues, but on the
> whole this is the direction I think we should take with regard to
> porting Go application.
> 
> The biggest issue with the diff is it's inability to cope with the way
> Go escapes[1] uppercase letters in URLs. This means that this
> implementation can't package things like "github.com/gohugoio/hugo" as
> it has some dependencies like: "github.com/BurntSushi/toml".

I would like to see this committed, so OK afresh1@, but some of the
changes are mine, so would definitely like to hear about regressions.

I thought I had mailed out the Port.pm changes already, but it seems I
didn't actually do that.   I think that should go in separately, and can
probably commit them on Thursday or so.  The diff Aaron posted is
missing a bit of cleanup to Dependency.pm related to the improvements to
formatting, so the full patch for that is attached as:

portgen-multi_value_values.patch

I do have a couple other patches out looking for OKs, or at least
"doesn't seem to break anything" reports.

This should detect ports that need FIX_EXTRACT_PERMISSIONS and set it:
portgen-fix_extract_permissions.patch
https://marc.info/?l=openbsd-ports&m=157454704431952&w=2

Then one that looks up existing ports by "stem" instead of the current
heuristic.  The worry here would be finding the "wrong" existing port,
but with this new way it should be easier to munge things and detect
more existing ports if necessary.

portgen-lookup_existing_ports_by_stem.patch
https://marc.info/?l=openbsd-ports&m=157515508030392&w=2

Index: infrastructure/lib/OpenBSD/PortGen/Dependency.pm
===================================================================
RCS file: /cvs/ports/infrastructure/lib/OpenBSD/PortGen/Dependency.pm,v
retrieving revision 1.2
diff -u -p -r1.2 Dependency.pm
--- infrastructure/lib/OpenBSD/PortGen/Dependency.pm    12 May 2019 20:23:33 
-0000      1.2
+++ infrastructure/lib/OpenBSD/PortGen/Dependency.pm    8 Dec 2019 21:35:41 
-0000
@@ -109,10 +109,6 @@ sub format
                @{ $fmt{'test'} } = '${RUN_DEPENDS}';
        }
 
-       for my $type ( keys %fmt ) {
-               $fmt{$type} = ( join " \\\n\t\t\t", @{ $fmt{$type} } ) || undef;
-       }
-
        return \%fmt;
 }
 
Index: infrastructure/lib/OpenBSD/PortGen/Port.pm
===================================================================
RCS file: /cvs/ports/infrastructure/lib/OpenBSD/PortGen/Port.pm,v
retrieving revision 1.18
diff -u -p -r1.18 Port.pm
--- infrastructure/lib/OpenBSD/PortGen/Port.pm  12 Jun 2019 19:25:53 -0000      
1.18
+++ infrastructure/lib/OpenBSD/PortGen/Port.pm  8 Dec 2019 21:35:41 -0000
@@ -203,9 +205,7 @@ sub set_build_deps
 {
        my ( $self, $build_deps ) = @_;
 
-       # Makefile.template is missing a tab for BUILD_DEPENDS
-       # and we want the port to be pretty, so add one
-       $self->{BUILD_DEPENDS} = "\t" . $build_deps if $build_deps;
+       $self->{BUILD_DEPENDS} = $build_deps;
 }
 
 sub set_run_deps
@@ -344,6 +375,22 @@ sub write_makefile
        delete $configs{EXTRACT_SUFX}
            if $configs{EXTRACT_SUFX} and $configs{EXTRACT_SUFX} eq '.tar.gz';
 
+       my $format = sub {
+               my ($key, $value, %opts) = @_;
+
+               my $tabs = "\t" x ( $opts{tabs} || 1 );
+               $key .= $opts{equal} || $default_equal;
+
+               if (ref $value eq 'ARRAY') {
+                       my $key_tabs = "\t" x ( length($key) / 8 );
+                       $value = join " \\\n$key_tabs$tabs", @{ $value }
+               }
+
+               $key .= $tabs if length $value;
+
+               return $key . $value;
+       };
+
        my @makefile;
        foreach my $line (@template) {
                next    # no more than one blank line
@@ -358,10 +405,7 @@ sub write_makefile
                                next if $key !~ /^[\p{Upper}_]+(?:-\w+)?$/;
                                my $value = $configs{$key};
                                next unless defined $value;
-
-                               my $print_key = "$key$default_equal";
-                               $print_key .= "\t" if length $value;
-                               push @additions, "$print_key$value";
+                               push @additions, $format->($key, $value);
                        }
                        if (@additions) {
                                push @makefile,
@@ -382,19 +426,12 @@ sub write_makefile
                        }
 
                        # If we didn't get a value, copy from the template
-                       if ( not $value and %copy_values ) {
-                               $value = $line->{value}
-                                   if $copy_values{$key}
-                                   and not $reset_values{$key};
-                       }
+                       $value ||= $line->{value}
+                           if $copy_values{$key}
+                           and not $reset_values{$key};
 
                        next unless defined $value;
 
-                       my $equal = $line->{equal} || $default_equal;
-                       my $tabs      = "\t" x ( $line->{tabs} || 1 );
-                       my $print_key = "$key$equal";
-                       $print_key .= $tabs if length $value;
-
                        if ( $key eq 'PERMIT_PACKAGE' && $license ) {
                                # guess that the comment before this was
                                # the license marker.
@@ -402,7 +439,7 @@ sub write_makefile
                                push @makefile, "# $license";
                        }
 
-                       push @makefile, "$print_key$value";
+                       push @makefile, $format->($key, $value, %{$line});
                } else {
                        push @makefile, $line;
                }
Index: infrastructure/lib/OpenBSD/PortGen/Port.pm
===================================================================
RCS file: /cvs/ports/infrastructure/lib/OpenBSD/PortGen/Port.pm,v
retrieving revision 1.18
diff -u -p -r1.18 Port.pm
--- infrastructure/lib/OpenBSD/PortGen/Port.pm  12 Jun 2019 19:25:53 -0000      
1.18
+++ infrastructure/lib/OpenBSD/PortGen/Port.pm  8 Dec 2019 21:35:41 -0000
@@ -21,6 +21,8 @@ use 5.012;
 use warnings;
 
 use Cwd;
+use Fcntl qw( :mode );
+use File::Find qw();
 use File::Path qw( make_path );
 use JSON::PP;
 use Text::Wrap;
@@ -222,6 +222,37 @@ sub set_test_deps
        $self->{TEST_DEPENDS} = $test_deps;
 }
 
+sub set_fix_extract_permissions
+{
+       my ($self, $value) = @_;
+
+       return $self->{FIX_EXTRACT_PERMISSIONS} = $value
+           if @_ == 2;
+
+       my $perm_file = S_IRUSR | S_IRGRP | S_IROTH;
+       my $perm_dir  = S_IXUSR | S_IXGRP | S_IXOTH | $perm_file;
+
+       # Assume a cached stat on whatever mode we are checking
+       my $perm_ok = sub {
+               my $mode = ( stat _ )[2];
+               return S_ISDIR($mode)
+                   ? ($mode & $perm_dir ) == $perm_dir
+                   : ($mode & $perm_file) == $perm_file;
+       };
+
+       my $wrksrc = $self->make_show('WRKSRC');
+
+       # Look through WRKSRC for files that don't have
+       # the necessary permissions.
+       my $needs_fix;
+       File::Find::find({ no_chdir => 1, wanted => sub {
+               $needs_fix = $File::Find::prune = 1
+                   if $needs_fix or not $perm_ok->();
+       } }, $wrksrc );
+
+       return $self->{FIX_EXTRACT_PERMISSIONS} = $needs_fix ? 'Yes' : undef;
+}
+
 sub set_other
 {
        my ( $self, $var, $value ) = @_;
@@ -535,7 +572,14 @@ sub make_port
 
        $self->make_makesum();
        $self->make_checksum();
+       $self->make_clean();
        $self->make_extract();
+
+       if ( $self->set_fix_extract_permissions() ) {
+               $self->write_makefile();
+               $self->make_clean();
+               $self->make_extract();
+       }
 
        my $wrksrc = $self->make_show('WRKSRC');
 
Index: infrastructure/lib/OpenBSD/PortGen/Utils.pm
===================================================================
RCS file: /cvs/ports/infrastructure/lib/OpenBSD/PortGen/Utils.pm,v
retrieving revision 1.5
diff -u -p -r1.5 Utils.pm
--- infrastructure/lib/OpenBSD/PortGen/Utils.pm 23 Nov 2019 14:59:39 -0000      
1.5
+++ infrastructure/lib/OpenBSD/PortGen/Utils.pm 8 Dec 2019 21:35:41 -0000
@@ -18,6 +18,7 @@ package OpenBSD::PortGen::Utils;
 
 use 5.012;
 use warnings;
+use feature qw( state );
 
 use parent qw( Exporter );
 
@@ -47,12 +48,8 @@ sub ports_dir { $ENV{PORTSDIR} || '/usr/
 
 sub base_dir { ports_dir() . '/mystuff' }
 
-sub module_in_ports
+sub _module_sth
 {
-       my ( $module, $prefix ) = @_;
-
-       return unless $module and $prefix;
-
        my $dbfile = '/usr/local/share/sqlports';
        die "install databases/sqlports and databases/p5-DBD-SQLite\n"
            unless -e $dbfile;
@@ -64,22 +61,34 @@ sub module_in_ports
            RaiseError => 1,
        } ) or die "failed to connect to database: $DBI::errstr";
 
-       my @results = @{ $dbh->selectcol_arrayref(
-           "SELECT _paths.fullpkgpath FROM _paths JOIN _paths p1 ON 
p1.pkgpath=_paths.id
-               JOIN _ports ON _ports.fullpkgpath=p1.id WHERE _ports.distname 
LIKE ?",
-           {}, "$module%"
-       ) };
-
-       $dbh->disconnect();
-
-       # just returning the shortest one that's a module of the same ecosystem
-       # this should be improved
-       @results = sort { length $a <=> length $b } @results;
-
-       # this works well enough in practice, but can't rely on it
-       # see devel/perltidy
-       for (@results) {
-               return $_ if /\/$prefix/;
+       return $dbh->prepare(q{
+           SELECT _Paths.FullPkgPath FROM _Paths
+             JOIN _Ports ON _Paths.PkgPath = _Ports.FullPkgPath
+            WHERE PKGSTEM = ?
+              AND _Paths.Id = _Paths.PkgPath
+            ORDER BY LENGTH(_Paths.FullPkgPath)
+       });
+}
+
+sub module_in_ports
+{
+       my ( $module, $prefix ) = @_;
+       return unless $module and $prefix;
+
+       state $sth = _module_sth();
+       END { undef $sth }; # Bus error if destroyed during global destruction
+
+       my @stems = ( $prefix . $module );
+
+       # We commonly convert the port to lowercase
+       push @stems, $prefix . lc($module) if $module =~ /\p{Upper}/;
+
+       foreach my $stem (@stems) {
+               $sth->execute($stem);
+               my ($path, @extra) = map {@$_} @{ $sth->fetchall_arrayref };
+               warn "Found paths other than $path: @extra\n"
+                   if @extra;
+               return $path if $path;
        }
 
        # Many ports, in particular python ports, start with $prefix,
Index: infrastructure/lib/OpenBSD/PortGen/Port/PyPI.pm
===================================================================
RCS file: /cvs/ports/infrastructure/lib/OpenBSD/PortGen/Port/PyPI.pm,v
retrieving revision 1.17
diff -u -p -r1.17 PyPI.pm
--- infrastructure/lib/OpenBSD/PortGen/Port/PyPI.pm     15 Jul 2019 13:35:35 
-0000      1.17
+++ infrastructure/lib/OpenBSD/PortGen/Port/PyPI.pm     8 Dec 2019 21:35:41 
-0000
@@ -54,11 +54,20 @@ sub name_new_port
 {
        my ( $self, $di ) = @_;
 
-       my $name = ref $di ? $di->{info}{name} : $di;
-       $name =~ s/^python-/py-/;
+       my $module = ref $di ? $di->{info}{name} : $di;
+       $module =~ s/^python-/py-/;
 
-       $name = $self->SUPER::name_new_port($name);
-       $name = "pypi/$name" unless $name =~ m{/};
+       my $name = $self->SUPER::name_new_port($module);
+
+       # Try for a py3 only version if we didn't find something ported
+       unless ( $name =~ m{/} ) {
+               if ( my $p = module_in_ports( $name, 'py3-' ) ) {
+                       $name = $p;
+               }
+               else {
+                       $name = "pypi/$name"
+               }
+       }
 
        return $name;
 }
@@ -171,7 +180,8 @@ sub get_deps
 
                next if @plat and join( " ", @plat ) !~ /OpenBSD/i;
 
-               my $port = module_in_ports( $name, 'py-' );
+               my $port = module_in_ports( $name, 'py-' )
+                   || module_in_ports( $name, 'py3-' );
                my $dep_dir;
 
                if ($port) {

Reply via email to