cygwin patches integrating back into standard gnu

["Edward S. Peschko" <esp5 at pge dot com>]

I was curious - exactly what is the process to submit cygwin patches to the respective
projects that support cygwin as a target?

I've been integrating cygwin into the build for the OSes I support, and I find that there
are hundreds of thousands of lines of patches for cygwin (around 400k). Some are 
trivial, some are fairly substantial (ex: popt's patch is approx 1/3 the size of the 
regular distribution!)

I'm loathe to have to support these patches, esepcially because some seem
to be cross-platform unfriendly, so I was hoping that some sort of concerted effort
is being made or could be made to make the ported cygwin packages 'build clean from the 
box', so that ./configure --prefix=<..>; make; make install would work for 99% of them 
without patching.

To that end, I've put together - attached to this message - a small perl script that 
goes off, fetches all of the latest cygwin project source code, and extracts all the 
patches and README files from the tarred packages..  It saves the source files in 
'./build', and the patches in './patches' It should run as-is under cygwin, but if it
doesn't I wouldn't mind putting together a small PAR file to make it self-contained.

Anyways, I could (or someone could) modify it so that, as an option, the patches 
within are sent to the appropriate mailing list for inclusion. I would think that such a 
matrix would be helpful in general, as well as a centralized user which could be a 
conduit for submitting patches to the right place. (which to me is a lot better idea 
than everyone using the script to send the same patch over and over) But 400k of patches 
seems just a bit high.

Ed

---- extract_cygwin_patches.p ----
use strict;
use File::Path;
use FileHandle;
use Data::Dumper;

mkdir("build");  
system("rm -rf patches");
mkdir("patches");

chdir("build");

my $cygwin_entries = cache_cygwin();
my $cygwin_projects  = cygwin_projects( $cygwin_entries);

my $project;
foreach $project (@$cygwin_projects)
{
  print STDERR "\n----\nGETTING PROJECT :$project:\n----\n";
  my $latest_project = get_latest_project($project, $cygwin_entries);

  my ($shortpath) = ($latest_project =~ m"(?:.*)/(.*)"sg);

  system("rm -f $shortpath") if (-e $shortpath);

  ftp("ftp://planetmirror.com/pub/cygwin/$latest_project";) if (!-e $shortpath);
  extract_patch($latest_project, $project );
}

cleanup();

sub cleanup
{
  chdir("../patches");

  my $file;
  foreach $file (glob("*"))
  {
    if ( $file !~ m"\.patch$" && $file !~ m"README") #" 
    {
      system("rm -f $file") if (-e $file);
    }
  }
}

chdir("..");
# -- start subs ---
sub shell
{
  my $fh = new FileHandle($_[0]);
  my $line = <$fh>;
  close($fh);

  return(1) if ($line =~ m"^#!" || $line =~ m"#.*shell");
  return(0);
}

sub cache_cygwin
{
  if (-e "ls-lR.gz") { system("rm ls-lR.gz"); }
  ftp('ftp://planetmirror.com/pub/cygwin/ls-lR.gz');

  my $cygwin = _ls_lr("ls-lR");
  my @return = grep(m"release" && m"-src" && m"\.tar\.gz|\.tar\.bz2", @$cygwin);
  return(\@return);
}

sub cygwin_projects
{
  my ($entries) = @_;
  my %MATCH;

  grep { m"^./release(/[^/]+/)" && $MATCH{$1}++ }  @$entries; 
  my @projects = sort keys(%MATCH);
  return(\@projects);
}

sub get_latest_project
{
  my ($project, $cygwin_projects) = @_;

  my @releases = grep(m"$project", @$cygwin_projects);
  @releases = sort { _cygwin_tuple($b, $a) } @releases;

  return($releases[0]);
}

sub extract_patch
{
  my ($latest_project, $project) = @_;

  $project =~ s"/""sg;

  my ($shortpath) = ($latest_project =~ m".*/(.*)");
  my $filenames = tar($shortpath, { list => 1 });
  my @patches_or_hints = grep(m"(?:patch|cygwin)"i, @$filenames); #"
  @patches_or_hints = grep(!m"\.c$", @patches_or_hints); #"

  if (@patches_or_hints)
  {
    tar($shortpath, { extract => 1, filenames => \@patches_or_hints, 
                  outflat => "../patches/${project}_<file>",
                  outfull => 0 });
  }
  else
  {
    print STDERR "Package $shortpath does not have any patches!!\n";
  }
}

sub tar
{
  my ($shortpath, $config) = @_;

  if ($config->{list})
  {
    my @files = ($shortpath =~ m"\.bz2$")? `/bin/tar tjf $shortpath` :  #"
            ($shortpath =~ m"\.tar.gz$")? `/bin/tar tzf $shortpath` :  #"
              ($shortpath =~ m"\.tar$")? `/bin/tar tf $shortpath` :
              `/bin/tar tf $shortpath`; #"
    chomp(@files);
    return(\@files);
  }
  elsif ($config->{extract})
  {
    my $flags = 
      ($shortpath =~ m"\.bz2$")? "xjf" :  #"
      ($shortpath =~ m"\.tar.gz$")? "tzf" : #"
      ($shortpath =~ m"\.tar$")? "tf" : "tf"; #"

    my @filenames = ($config->{filenames})? @{$config->{filenames}} : ();

    if ($config->{filenames} && !@{$config->{filenames}})
    {
      print STDERR "you asked not to extract any files from $shortpath!Skipping.\n";
    }

    if ($config->{outflat})
    {
      mkdir("tmpdir.$$");
      chdir("tmpdir.$$");

      system("/bin/tar $flags ../$shortpath @filenames");
      @filenames = grep( -f $_, @filenames);

      my $file;
      foreach $file (@filenames)
      {
        my $sub = $config->{outflat};

        my $sf = $file;
        $sf =~ s"/"_"sg if ($config->{outfull});
        $sf =~ s"(.*)/""sg if (!$config->{outfull});

        $sub =~ s"<file>"$sf";

        if ($sub !~ m"^/")
        {
          my $subrel = "../$sub";
          $subrel = _addnumber($subrel);

          _mkdirfromfile("$subrel") if ($sub !~ m"^/");

          system("rm -f $subrel") if (-e "../$sub");
          system("mv $file $subrel") if ($sub !~ m"^/");
        }
        else
        {
          $sub = _addnumber($sub);

          _mkdirfromfile("$sub") if ($sub =~ m"^/");

          system("rm -f $sub") if (-e $sub);
          system("mv $file $sub") if ($sub =~ m"^/");
        }
      }
      chdir("..");
      system("rm -rf tmpdir.$$");
    }
  }
}
sub _addnumber
{
  my ($file) = @_;

  my $newfile = $file;
  my $num;

  while (-e $newfile)
  {
    $num++;
    $newfile = "$file.$num";
  }
  return($newfile);
}

sub ftp
{
  my ($url) = @_;
  system("/bin/wget $url");
}

sub _ls_lr
{
  my ($filename) = @_;

  my $current_target;
  local($/) = undef;
  my $fh;
  my $line; 

  print STDERR `pwd`;
  if (-e $filename)
  {
    $fh = new FileHandle( $filename) || die "SYSTEM ERROR: Couldn't open $filename\n";
    $line = <$fh>;
    close($fh);
  }
  elsif (-e "$filename.gz")
  {
    $fh = new FileHandle( "/bin/gzip -dc $filename.gz |") || die "SYSTEM ERROR: Couldn't open $filename\n";
    $line = <$fh>;
    close($fh);
  }

  my @lines = split (m"\n", $line);

  my @return;

  foreach $line (@lines)
  {
    chomp($line);
    if ($line =~ m"^(\./(?:.*)):") { $current_target = $1; }
    next if (!$current_target);
  
    if ($line =~ m"-")
    {
      my ($filename) = ($line =~ m".*\s+(.*)");
      push(@return, "$current_target/$filename");
    }
  }
  return(\@return);
}

sub _mkdirfromfile
{
  my ($logname) = @_;

  return() if ($logname !~ m"/");
  my ($dir, $file) = ($logname =~ m"(.*)/(.*)");

  if (!-d $dir)
  {
    my $status = mkpath( [ $dir ], 0, 0755);
    if (!$status)
    {
      Carp::cluck("SYSTEM ERROR: Couldn't open directory $dir\n");
    }
  }
}
                                 
sub _tuple
{
  my ($tup1, $tup2) = @_;

  if (!$tup2) { return(1) if ($tup1 =~ m"\." || $tup1 =~ m"^\d+\w+$"); return(0); } #"

  my @elts1 = split(m"\.", $tup1);
  my @elts2 = split(m"\.", $tup2);

  my $lim = (@elts1 == @elts2)? @elts1 : (@elts1 > @elts2)? @elts1 : @elts2;

  my $score = 0;

  my $elt;
  my $xx;
  for ($xx = 0; $xx < $lim; $xx++)
  {
    if ($elts1[$xx] ne $elts2[$xx])
    {
      if (!_num($elts1[$xx]) || !_num($elts2[$xx]))
      {
        my ($ver1, $sub1) = ($elts1[$xx] =~ m"([0-9]*)([a-zA-Z]*.*)");
        my ($ver2, $sub2) = ($elts2[$xx] =~ m"([0-9]*)([a-zA-Z]*.*)");

        return($ver1 <=> $ver2) if ($ver1 != $ver2);
        return($sub1 cmp $sub2) if ($sub1 ne $sub2);
      }
      else
      {
        return($elts1[$xx] <=> $elts2[$xx]);
      }
    }
  }
  return(0);
}

sub _date
{
  return(1) if (($_[0] =~ m"\d{8,8}") && @_ == 1);
  return(1) if (($_[0] =~ m"\d{6,6}") && @_ == 1);

  my ($yyyy1, $mm1, $dd1, $yyyy2, $mm2, $dd2);

  if ($_[0] =~ m"\d{8,8}")
  {
    ($yyyy1, $mm1, $dd1) = ($_[0] =~ m"(....)(..)(..)");
  }
  else
  {
    ($mm1, $dd1, $yyyy1) = ($_[0] =~ m"(..)(..)(..)");
    $yyyy1 = ($yyyy1 < 79)? "20$yyyy1" : "19$yyyy1";
  }

  if ($_[1] =~ m"\d{8,8}")
  {
    ($yyyy2, $mm2, $dd2) = ($_[1] =~ m"(....)(..)(..)");
  }
  else
  {
    ($mm2, $dd2, $yyyy2) = ($_[0] =~ m"(..)(..)(..)");
    $yyyy2 = ($yyyy2 < 79)? "20$yyyy2" : "19$yyyy2";
  }
  
  return($yyyy1 <=> $yyyy2) if ($yyyy1 != $yyyy2);
  return($mm1 <=> $mm2) if ($mm1 != $mm2);
  return($dd1 <=> $dd2) if ($dd1 != $dd2);
}

sub _cygwin_tuple 
{
  my ($a, $b) = @_;

  my ($elts1) = ($a =~ m"-([0-9].*)\.tar");
  my ($elts2) = ($b =~ m"-([0-9].*)\.tar");

  my (@elts1) = split(m"[-]", $elts1);
  my (@elts2) = split(m"[-]", $elts2);

  my $lim = (@elts1 == @elts2)? @elts1 : (@elts1 > @elts2)? @elts1 : @elts2;


  my $xx;
  for ($xx = 0; $xx < $lim; $xx++)
  {

    if (_date($elts1[$xx]) && _date($elts2[$xx]) && $elts1[$xx] ne $elts2[$xx]) 
    {
      return(_date($elts1[$xx], $elts2[$xx])); 
    }
    elsif (_tuple($elts1[$xx]) && _tuple($elts2[$xx]) && $elts1[$xx] ne $elts2[$xx]) 
      { return(_tuple($elts1[$xx], $elts2[$xx])); }

    elsif (!length($elts1[$xx]) && length($elts2[$xx]))
      { return(1); }

    elsif (!length($elts2[$xx]) && length($elts1[$xx]))
      { return(-1); }

    elsif (_tuple($elts1[$xx]) && _date($elts2[$xx]))
      { return(-1); }

    elsif (_tuple($elts2[$xx]) && _date($elts1[$xx]))
      { return(1); }

    elsif (_num($elts1[$xx]) && !_num($elts2[$xx]))
      { return(1); }

    elsif (_num($elts2[$xx]) && !_num($elts1[$xx]))
      { return(1); }

    else
    {
      if ($elts1[$xx] != $elts2[$xx]) 
        { return($elts1[$xx] <=> $elts2[$xx]);  }
    }
  }
  return(0);
}

sub _num
{
  return(1) if (($_[0] ne '0' && $_[0] != 0 && $_[0] !~ m"[^\d]" ) || $_[0] eq '0');
  return(0);
}


--
Unsubscribe info:      http://cygwin.com/ml/#unsubscribe-simple
Problem reports:       http://cygwin.com/problems.html
Documentation:         http://cygwin.com/docs.html
FAQ:                   http://cygwin.com/faq/