505 lines
16 KiB
Perl
Executable File
505 lines
16 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
#
|
|
# pkg-repgen: generates a binary repository for pkg-get
|
|
#
|
|
# requires prt-get
|
|
#
|
|
# html index generation code adapted from Jukka Heino's portspage
|
|
#
|
|
# usage: pkg-repgen [options] [directory [pkgname1..pkgnameN]]
|
|
#
|
|
|
|
use warnings;
|
|
use strict;
|
|
use Getopt::Long;
|
|
use Digest::file qw(digest_file_hex);
|
|
|
|
our $prtget = "/usr/bin/prt-get"; our $prtdir;
|
|
our $title = "CRUX Packages"; our $header; our $footer;
|
|
GetOptions("prtdir=s"=>\$prtdir, "title=s"=>\$title, "header=s"=>\$header, "footer=s"=>\$footer);
|
|
|
|
# Use compression-mode defined in pkgmk-conf
|
|
our $compress = "gz";
|
|
open CONFIG, "/etc/pkgmk.conf" or die "Could not open /etc/pkgmk.conf";
|
|
while (<CONFIG>) {
|
|
$compress = $1 if m/^PKGMK_COMPRESSION_MODE=(.*)(\#|$)/;
|
|
}
|
|
close CONFIG;
|
|
$compress =~ s/["' ]//g;
|
|
|
|
$prtget .= " --no-std-config --config-set=\"prtdir $prtdir\"" if ($prtdir);
|
|
|
|
my @packages; my %isDup;
|
|
|
|
sub pkg_mtime {
|
|
my $aName = $a; my $bName = $b;
|
|
my $aTime; my $bTime;
|
|
$aName =~ s/#.*//;
|
|
$bName =~ s/#.*//;
|
|
if ($aName lt $bName) { return -1; }
|
|
elsif ($aName gt $bName) { return 1; }
|
|
else {
|
|
$aTime = (stat $a)[9];
|
|
$bTime = (stat $b)[9];
|
|
}
|
|
if ($aTime le $bTime) { return -1; }
|
|
else { return 1; }
|
|
}
|
|
|
|
my $pkgdir = shift @ARGV; my $quickMode=0;
|
|
if (($pkgdir) and (! -d "$pkgdir")) {
|
|
print "usage: pkg-repgen [options] [directory [pkgname1..pkgnameN]]\n";
|
|
exit 1;
|
|
}
|
|
my @dirlist = ("$pkgdir") ? glob("$pkgdir/*.pkg.tar.$compress") : glob("*.pkg.tar.$compress");
|
|
@dirlist = sort pkg_mtime @dirlist;
|
|
%isDup = map { $_ => 0 } @dirlist;
|
|
|
|
if (@ARGV) { # individual packages
|
|
$quickMode=1;
|
|
my @updates = sort @ARGV;
|
|
while (my $name = shift @updates) {
|
|
push @packages, grep { m/$name#.*\.pkg/ } @dirlist;
|
|
}
|
|
} else { # the entire directory
|
|
@packages = @dirlist;
|
|
}
|
|
|
|
# hashes to determine the package name ...
|
|
our %pname = map { $_ => (split /\//, $_)[-1] } @dirlist;
|
|
foreach my $p (@dirlist) { $pname{$p} =~ s/\#.*//; }
|
|
|
|
# ... or to look up the successor when merging old metadata files
|
|
my %followR; my %followH; my %followD; my @queue = @dirlist;
|
|
while (my $q = shift @queue) {
|
|
($#queue < 0) or ($pname{$q} ne $pname{$queue[0]}) or $isDup{$q} = 1;
|
|
}
|
|
|
|
# Populate some other hashes using a single run of prt-get
|
|
our %path; our %depends; our %descrip; our %flags;
|
|
my @validkeys = map { (split /\//, $_)[-1] } @dirlist;
|
|
map { s/\#.*// } @validkeys;
|
|
my %printme = map { $_ => 1 } @validkeys;
|
|
open (my $ppf, "$prtget printf '%n^%p^%e^%d^%E:%O:%R\n' |");
|
|
while (<$ppf>) {
|
|
chomp;
|
|
my ($name,$repo,$deps,$desc,$prepostread) = split /\^/;
|
|
next if (! $printme{$name});
|
|
$path{$name} = $repo . "/" . $name;
|
|
$depends{$name} = $deps;
|
|
$desc =~ s/\:/ /g;
|
|
$descrip{$name} = $desc;
|
|
$flags{$name} = $prepostread;
|
|
}
|
|
close ($ppf);
|
|
|
|
# Needed for alternating colors in the html index
|
|
my %parity = ( 0 => "even", 1 => "odd" );
|
|
|
|
# Generate the metadata files
|
|
($quickMode) ? pkg_single() : pkg_dir();
|
|
|
|
# Generate README and PKGINST
|
|
pkgreadscripts();
|
|
|
|
###################### individual packages ##########################
|
|
sub pkg_single {
|
|
my ($oR, $oD, $oH, $nR, $nD, $nH, $oline, $oname);
|
|
my $count = 0; # needed for the html index
|
|
my @dep_packages = @packages;
|
|
my @idx_packages = @packages;
|
|
|
|
my %firstrun = map { $_ => 0 } ("PKGREPO", "PKGDEPS", "index.html");
|
|
open ($oR, "$pkgdir/PKGREPO") or $firstrun{"PKGREPO"} = 1;
|
|
open ($oD, "$pkgdir/PKGDEPS") or $firstrun{"PKGDEPS"} = 1;
|
|
open ($oH, "$pkgdir/index.html") or $firstrun{"index.html"} = 1;
|
|
|
|
open ($nR, ">$pkgdir/PKGREPO.new");
|
|
print "+ Updating specified entries in repository\n";
|
|
RPKG: while (my $p =shift @packages) {
|
|
my ($basename, $du, $md5, $ppr) = repodata($p);
|
|
my $desc = (! $descrip{$pname{$p}}) ? "N.A." : $descrip{$pname{$p}};
|
|
if ($firstrun{"PKGREPO"}==1) {
|
|
printf $nR "%-s:%-s:%-s:%-s:%-s\n",$basename, $du, $md5, $desc, $ppr;
|
|
next RPKG;
|
|
}
|
|
|
|
# Shift entries from the old repository until we find
|
|
# a successor to the current package.
|
|
while ( (! $followR{$pname{$p}}) and $oline = <$oR> ) {
|
|
chomp($oline); $oname = $oline;
|
|
$oname =~ s/\#.*//;
|
|
print $nR "$oline\n" if ($oname lt $pname{$p});
|
|
|
|
# before breaking out of the loop, append all the packages
|
|
# from the globbed queue that are lexographically earlier
|
|
# than the current entry in the old repository.
|
|
while ($pname{$p} le $oname) {
|
|
printf $nR "%-s:%-s:%-s:%-s:%-s\n", $basename, $du, $md5, $desc, $ppr;
|
|
next RPKG if (! $isDup{$p});
|
|
$p = shift @packages;
|
|
($basename, $du, $md5, $ppr) = repodata($p);
|
|
$desc = (! $descrip{$pname{$p}}) ? "N.A." : $descrip{$pname{$p}};
|
|
|
|
# save what got shifted from the repository if we're not going to
|
|
# print it now, but don't save packages that match the same glob.
|
|
$followR{$pname{$p}} = "$oline\n" if ($pname{$p} lt $oname);
|
|
}
|
|
}
|
|
|
|
# if the current package comes after everything in the old repository,
|
|
# just append its metadata
|
|
($followR{$pname{$p}}) or printf $nR "%-s:%-s:%-s:%-s:%-s\n", $basename, $du, $md5, $desc, $ppr;
|
|
|
|
next RPKG if (($isDup{$p}) or (! $followR{$pname{$p}}));
|
|
|
|
# Arriving here means the current package is not a dup, and
|
|
# definitely has a successor in the old repository. But the
|
|
# next globbed package might be a more immediate successor.
|
|
# Decide which of the two possible successors comes first.
|
|
# By defining a successor for the next package in the queue,
|
|
# we delay shifting entries off the old repo.
|
|
if ((@packages) and ($pname{$packages[0]} le $followR{$pname{$p}})) {
|
|
$followR{$pname{$packages[0]}} = $followR{$pname{$p}};
|
|
next RPKG;
|
|
} else {
|
|
print $nR $followR{$pname{$p}};
|
|
}
|
|
|
|
# Shift another package from the queue
|
|
}
|
|
|
|
# Likewise for the html index
|
|
printheader(1);
|
|
open ($nH, ">>$pkgdir/index.html.new");
|
|
|
|
print "+ Updating specified entries in the html index\n";
|
|
HPKG: while (my $p =shift @idx_packages) {
|
|
my ($url, $pver, $desc, $date) = htmldata($p);
|
|
|
|
if ($firstrun{"index.html"} == 1) {
|
|
$count++;
|
|
htmlrow($nH,$count,$pname{$p},$url,$pver,$desc,$date);
|
|
next HPKG;
|
|
}
|
|
# Shift entries from the old html index until we find
|
|
# a successor to the current package.
|
|
while ( (! $followH{$pname{$p}}) and $oline=<$oH> ) {
|
|
chomp($oline);
|
|
# no need to copy the header, it should already be there
|
|
next if ($oline !~ m/^<tr class="(odd|even)"/);
|
|
|
|
$oname = $oline;
|
|
$oname =~ s/.*a href="(.*)"/$1/; $oname =~ s/\%23.*//;
|
|
if ($oname lt $pname{$p}) { $count++; print $nH "$oline\n"; }
|
|
|
|
# before breaking out of the loop, append all the packages
|
|
# from the globbed queue that are lexographically earlier
|
|
# than the current entry in the old html index.
|
|
while ($pname{$p} le $oname) {
|
|
$count++;
|
|
htmlrow($nH,$count,$pname{$p},$url,$pver,$desc,$date);
|
|
next HPKG if (! $isDup{$p});
|
|
$p = shift @idx_packages;
|
|
($url, $pver, $desc, $date) = htmldata($p);
|
|
|
|
# save what got shifted from the index if we're not going to print
|
|
# it now, but ignore packages that match the same glob.
|
|
$followH{$pname{$p}} = "$oline\n" if ($pname{$p} lt $oname);
|
|
}
|
|
}
|
|
|
|
# if the current package comes after everything in the old html index,
|
|
# just append its metadata
|
|
if (! $followH{$pname{$p}}) {
|
|
$count++;
|
|
htmlrow($nH,$count,$pname{$p},$url,$pver,$desc,$date);
|
|
}
|
|
|
|
next HPKG if (($isDup{$p}) or (! $followH{$pname{$p}}));
|
|
|
|
# Arriving here means the current package is not a dup, and
|
|
# definitely has a successor in the old html index. But the
|
|
# next globbed package might be a more immediate successor.
|
|
# Decide which of the two possible successors comes first. If the
|
|
# globbed package is the more immediate successor, use its name
|
|
# as a key to retain the most recent entry from the html index.
|
|
if ((@packages) and ($pname{$packages[0]} le $followH{$pname{$p}})) {
|
|
$followH{$pname{$packages[0]}} = $followH{$pname{$p}};
|
|
next HPKG;
|
|
} else {
|
|
$count++;
|
|
$followH{$pname{$p}} =~ s/class="(even|odd)"/class="$parity{($count %2)}"/;
|
|
print $nH $followH{$pname{$p}};
|
|
}
|
|
|
|
# Shift another package from the queue
|
|
}
|
|
|
|
# Likewise for the dependency map, but avoid creating duplicate entries
|
|
open ($nD, ">$pkgdir/PKGDEPS.new");
|
|
|
|
print "+ Updating specified entries in the depmap\n";
|
|
DPKG: while (my $p =shift @dep_packages) {
|
|
if ($firstrun{"PKGDEPS"}==1) {
|
|
(! $depends{$pname{$p}}) or ($isDup{$p})
|
|
or printf $nD "%-30s : %-s\n", $pname{$p}, $depends{$pname{$p}};
|
|
next DPKG;
|
|
}
|
|
# Shift entries from the old depmap until we find a successor
|
|
# to the current package
|
|
while ( (! $followD{$pname{$p}}) and $oline = <$oD> ) {
|
|
chomp($oline); $oname = $oline;
|
|
$oname =~ s/\s*\:.*//;
|
|
print $nD "$oline\n" if ($oname lt $pname{$p});
|
|
while ($pname{$p} le $oname) {
|
|
if (! $isDup{$p}) {
|
|
printf $nD "%-30s : %-s\n", $pname{$p}, $depends{$pname{$p}};
|
|
next DPKG;
|
|
} else {
|
|
$p = shift @dep_packages;
|
|
}
|
|
# save what got shifted from the depmap if we're not going to print
|
|
# it now, but ignore packages that match the same glob.
|
|
$followD{$pname{$p}} = $oline if ($pname{$p} lt $oname);
|
|
}
|
|
}
|
|
|
|
# if the current package comes after everything in the old depmap
|
|
# and is not a dup, just append its metadata
|
|
($followD{$pname{$p}}) or ($isDup{$p}) or (! $depends{$pname{$p}})
|
|
or printf $nD "%-30s : %-s\n", $pname{$p}, $depends{$pname{$p}};
|
|
|
|
next DPKG if (($isDup{$p}) or (! $followD{$pname{$p}}));
|
|
|
|
# Arriving here means the current package is not a dup, and
|
|
# definitely has a successor entry in the old depmap.
|
|
# But the next globbed package might be a more immediate successor.
|
|
# Decide which of the two possible successors comes first. If it's the
|
|
# globbed package that comes next, save the old depmap entry.
|
|
if ((@packages) and ($pname{$packages[0]} le $followD{$pname{$p}})) {
|
|
$followD{$pname{$packages[0]}} = $followD{$pname{$p}};
|
|
next DPKG;
|
|
} else {
|
|
printf $nD $followD{$pname{$p}};
|
|
}
|
|
|
|
# Shift another package from the queue
|
|
}
|
|
|
|
# Done with all the packages that match command-line arguments.
|
|
# Now append the tails of the old metadata files to their new counterparts.
|
|
while ($firstrun{"index.html"}==0 and $oline = <$oH>) {
|
|
$count++;
|
|
$oline =~ s/class="(even|odd)"/class="$parity{($count % 2)}"/;
|
|
print $nH $oline;
|
|
}
|
|
while ($firstrun{"PKGDEPS"}==0 and $oline = <$oD>) { print $nD $oline; }
|
|
while ($firstrun{"PKGREPO"}==0 and $oline = <$oR>) { print $nR $oline; }
|
|
|
|
close($nH);
|
|
close($nD);
|
|
close($nR);
|
|
($firstrun{"PKGREPO"}==1) or close($oR);
|
|
($firstrun{"PKGDEPS"}==1) or close($oD);
|
|
($firstrun{"index.html"}==1) or close($oH);
|
|
|
|
foreach my $db (keys %firstrun) { rename("$pkgdir/$db.new", "$pkgdir/$db"); }
|
|
printfooter($count) if ($firstrun{"index.html"} == 1);
|
|
}
|
|
|
|
######################## full repository ########################
|
|
sub pkg_dir {
|
|
print "+ Generating dependencies\n";
|
|
open (my $iD, ">$pkgdir/PKGDEPS");
|
|
print "+ Generating repository\n";
|
|
open (my $iR, ">$pkgdir/PKGREPO");
|
|
printheader(0);
|
|
my $count = 0;
|
|
open (my $ih, ">>$pkgdir/index.html");
|
|
foreach my $p (@packages) {
|
|
my ($basename, $du, $md5, $ppr) = repodata($p);
|
|
my ($url, $pver, $desc, $date) = htmldata($p);
|
|
(! $depends{$pname{$p}}) or ($isDup{$p})
|
|
or printf $iD "%-30s : %-s\n", $pname{$p}, $depends{$pname{$p}};
|
|
printf $iR "%-s:%-s:%-s:%-s:%-s\n", $basename,$du,$md5,$desc,$ppr;
|
|
$count++;
|
|
htmlrow($ih,$count,$pname{$p},$url,$pver,$desc,$date);
|
|
}
|
|
close($ih);
|
|
printfooter($count);
|
|
close($iR);
|
|
close($iD);
|
|
}
|
|
|
|
# consolidate all the README and install scripts for the available packages
|
|
sub pkgreadscripts {
|
|
print "+ Generating README\n";
|
|
open (my $fR, ">$pkgdir/PKGREAD");
|
|
print $fR "# README files for repository. Do NOT remove this line.\n";
|
|
|
|
print "+ Generating scripts\n";
|
|
open (my $fS, ">$pkgdir/PKGINST");
|
|
print $fS '#!/usr/bin/env bash
|
|
#
|
|
# PKGINST: pre- and post-install scripts for CRUX packages
|
|
#
|
|
run_script() {
|
|
case "$1" in
|
|
';
|
|
|
|
my %seen;
|
|
foreach my $name (@dirlist) {
|
|
$name =~ s/\#.*//; $name = (split /\//, $name)[-1];
|
|
next if ($seen{$name});
|
|
$seen{$name} = 1;
|
|
next if (! $path{$name});
|
|
if (-f "$path{$name}/README"){
|
|
print $fR "##### PKGREADME: $name\n";
|
|
open(my $readme, "$path{$name}/README");
|
|
while (<$readme>){ print $fR $_; }
|
|
close($readme);
|
|
}
|
|
foreach my $when ("pre", "post") {
|
|
if (-f "$path{$name}/${when}-install"){
|
|
print $fS " $name.$when)\n";
|
|
open(my $rs, "$path{$name}/${when}-install");
|
|
while (<$rs>){
|
|
chomp;
|
|
(m/^\#(!.*sh|\s*EOF|\s*End)/) or print $fS " $_\n";
|
|
}
|
|
close($rs);
|
|
print $fS " ;;\n";
|
|
}
|
|
}
|
|
}
|
|
print $fS " esac\n}\n\n";
|
|
print $fS '[ "$1" ] && [[ "$2" == @(pre|post) ]] && run_script "$1.$2"';
|
|
print $fS "\n";
|
|
close $fS;
|
|
close $fR;
|
|
}
|
|
|
|
######################## html index subs ########################
|
|
|
|
sub printheader {
|
|
my $isTemp = shift; my $ih;
|
|
($isTemp == 0) ? open ($ih, ">$pkgdir/index.html") : open ($ih, ">$pkgdir/index.html.new");
|
|
print $ih <<EOH;
|
|
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
|
|
"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
|
|
<html xmlns="http://www.w3.org/1999/xhtml">
|
|
<head>
|
|
EOH
|
|
|
|
print $ih " <title>$title</title>\n";
|
|
|
|
print $ih <<EOH;
|
|
<style type="text/css">
|
|
body
|
|
{
|
|
font-family: Verdana, sans-serif;
|
|
font-size: 85%;
|
|
padding: 2em;
|
|
}
|
|
a
|
|
{
|
|
color: #67550d;
|
|
}
|
|
table
|
|
{
|
|
border: solid #e5dccf 1px;
|
|
font-size: 85%;
|
|
}
|
|
td
|
|
{
|
|
padding: 6px;
|
|
}
|
|
tr.header
|
|
{
|
|
background-color: #e5dccf;
|
|
}
|
|
tr.odd
|
|
{
|
|
background-color: #f7f3ed;
|
|
}
|
|
tr.even
|
|
{
|
|
background-color: #fcf9f8;
|
|
}
|
|
</style>
|
|
<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" />
|
|
</head>
|
|
<body>
|
|
EOH
|
|
|
|
print $ih " <h2>$title</h2>\n";
|
|
if ($header) {
|
|
open(FILE, $header) or die "Couldn't open header file";
|
|
while (<FILE>) { print $ih " " . $_; }
|
|
close(FILE);
|
|
}
|
|
|
|
print $ih " <table width=\"100%\" cellspacing=\"0\">\n";
|
|
print $ih " <tr class=\"header\"><td><b>Port</b></td><td><b>Version</b></td><td><b>Description</b></td>";
|
|
print $ih "<td><b>Last modified</b></td>";
|
|
print $ih "</tr>\n";
|
|
close($ih);
|
|
}
|
|
|
|
sub htmlrow {
|
|
my ($ih, $count, $name, $url, $version, $desc, $date) = @_;
|
|
print $ih "<tr class=\"$parity{($count % 2)}\"><td>$name</td>";
|
|
print $ih "<td><a href=\"$url\">$version</a></td>";
|
|
print $ih "<td>$desc</td><td>$date</td></tr>\n";
|
|
}
|
|
|
|
sub printfooter {
|
|
my $count = shift;
|
|
open (my $ih, ">>$pkgdir/index.html");
|
|
print $ih " </table>\n";
|
|
print $ih " <p><b>$count packages</b></p>\n";
|
|
if ($footer) {
|
|
open(FILE, $footer) or die "Couldn't open footer file";
|
|
while (<FILE>) { print $ih " " . $_; }
|
|
close(FILE);
|
|
}
|
|
print $ih " <p><i>Generated by <a href=\"http://www.varlock.com\">pkg-repgen</a> on " . isotime() . ".</i></p>\n";
|
|
print $ih <<EOH;
|
|
</body>
|
|
</html>
|
|
EOH
|
|
close($ih);
|
|
}
|
|
|
|
sub htmldata {
|
|
my $p = shift;
|
|
my ($pver, $url) = ($p, $p);
|
|
$pver =~ s/.*\#//; $pver =~ s/\.pkg\.tar.*//;
|
|
$url = (split /\//, $p)[-1]; $url =~ s/\#/\%23/;
|
|
my $date = isotime( (stat($p))[9], 1);
|
|
my $desc = (! $descrip{$pname{$p}}) ? "N.A." : $descrip{$pname{$p}};
|
|
return $url, $pver, $desc, $date;
|
|
}
|
|
|
|
sub repodata {
|
|
my $p = shift;
|
|
my $basename = (split /\//, $p)[-1];
|
|
my $du = (-s $p);
|
|
my $md5 = digest_file_hex($p,"MD5");
|
|
my $ppr = (! $flags{$pname{$p}}) ? "no:no:no" : $flags{$pname{$p}};
|
|
return $basename, $du, $md5, $ppr;
|
|
}
|
|
|
|
sub isotime {
|
|
my $time = (shift or time);
|
|
my $accuracy = (shift or 2);
|
|
my @t = gmtime ($time);
|
|
my $year = $t[5] + 1900;
|
|
my $month = sprintf("%02d", $t[4] + 1);
|
|
my $day = sprintf("%02d", $t[3]);
|
|
|
|
return "$year-$month-$day" if ($accuracy == 1);
|
|
return "$year-$month-$day " . sprintf("%02d:%02d:%02d UTC", $t[2], $t[1], $t[0]);
|
|
}
|