sbosrcarch initial commit

1 files changed, 831 insertions, 0 deletions

diff --git a/sbosrcarch b/sbosrcarch
new file mode 100644
index 0000000..0a4884d
--- /dev/null
+++ b/sbosrcarch
@@ -0,0 +1,831 @@
+#!/usr/bin/perl -w
+
+# sbosrcarch - Create and maintain an archive of SBo sources, based
+# on DOWNLOAD= and DOWNLOAD_x86_64= URLs in .info files.
+
+# Since a full archive would be pretty large (45GB or so), this script
+# allows limiting the size of the archive (but only indirectly, by
+# limiting the max file size it will download). This means we won't have
+# a full archive of every source tarball, but even a partial mirror is
+# still useful.
+
+# Rough guideline for choosing filesize:
+
+#Max filesize | Approx. total archive size | Coverage
+#       1.0M  |                    803.1M  |  68%
+#       2.0M  |                      1.4G  |  77%
+#       5.0M  |                      2.7G  |  85%
+#      10.0M  |                      4.3G  |  90%
+#      20.0M  |                      6.6G  |  93%
+#      35.0M  |                      8.9G  |  95%
+#      50.0M  |                     11.6G  |  96%
+#     100.0M  |                     16.6G  |  98%
+#  unlimited  |                     43.0G  | 100%
+
+# "Coverage" is the percentage of all the URLs in all the .info files
+# that will be kept in this archive. Notice that about 75% of the storage
+# space is eaten up by 2% of the files, in the unlimited case. These
+# large files are mostly games, if that influences your decision any.
+
+# This perl script is intended to work on at least Slackware 13.0
+# through 14.1, using only perl modules that ship with the OS (so no CPAN
+# dependencies). If you want to run it on some other OS, it might need
+# some extra stuff installed and/or some slight porting work. If you want
+# to keep a SBo source archive on your non-Slackware server, it might be
+# best to just rsync someone else's (that they build using this script).
+
+# A corollary of the above: we can use Net::FTP since it's in Slack's perl
+# package, but not LWP or LWP::Simple (instead, we system("wget $args")).
+
+## Usage:
+
+# TODO: implement all this stuff!
+
+# Initial archive creation:
+# sbosrcarch create
+# Should be run interactively, from a login shell. Takes a long
+# time to run and uses a lot of bandwidth. Log output goes
+# to stdout.
+# If the archive already exists, existing files will be kept
+# instead of being re-downloaded (provided of course their md5sums
+# are correct).
+
+# Daily or weekly cron job, looks at the git log:
+# sbosrcarch update
+# If there are aren't many changed download URLs, should run
+# quickly and not eat many resources. For each new URL, the
+# file is downloaded and added to the archive, but the old
+# file is *not* deleted (use 'sbosrcarch purge' to do that).
+
+# Monthly or quarterly cron job:
+# sbosrcarch purge
+# Will eat lots of RAM, CPU, and I/O, but not network. Gets rid of
+# files that are no longer referenced by any SBo .info file (e.g. old
+# version of stuff that's been updated).
+
+# Manually, after lowering $maxfilemegs:
+# sbosrcarch trim
+# Gets rid of files that are in the archive, but are larger than
+# the size limit. Shouldn't need to run this one from cron at all.
+
+# Manually add a single (possibly already downloaded) file to the repo:
+# sbosrcarch add [-f] category/prgnam [file ...]
+# Use -f to skip the size limit checking, so your archive can include
+# a few large files (perhaps because they're for builds you maintain).
+# Files added this way will still be deleted by 'sbosrcarch trim',
+# if they're larger than the limit.
+# This is intended to let the mirror operator keep a few large files, over
+# the maxfilemegs limit, or save bandwidth by using already-downloaded
+# copies (e.g. of stuff that was built recently).
+# If files are given after the category/prgnam argument, they will be
+# used instead of downloading the URLs in the .info files (provided
+# their md5sums match the .info file). Size limits are not checked for
+# files added this way.
+
+# Manually remove files from the archive:
+# sbosrcarch rm category/prgnam
+# ...but the next update will re-add anything you remove, if it's
+# less than the size limit. Mostly this is useful for manually-added
+# files that are over the limit.
+
+# TODO: check not yet implemented!
+# Check the integrity and coverage of the archive:
+# sbosrcarch check
+# Will report at least these conditions:
+# - dangling symlinks
+# - invalid md5sums
+# - files present in only one of by-name or by-md5 but not the other
+# - extraneous files in the tree
+# - generates a detailed status report, giving the total size,
+#   coverage, and a list of slackbuilds not covered.
+# Will not modify the archive in any way, but might recommend fixes.
+
+# Note that there's no need to run sbosrcarch as root. In fact, it's
+# recommended not to. Good choices for a user to run it as:
+# - your everyday user you log in as
+# - apache
+# - nobody
+
+## Config (eventually will be moved to a .conf file):
+
+# Unlikely that this will ever need to be changed.
+$sbogiturl = "git://slackbuilds.org/slackbuilds.git";
+
+# Location of local copy of SBo git clone. 'sbosrcarch create' will create
+# this via 'git clone' if it doesn't already exist. Should stay on master
+# branch. This script will take care of pulling from SBo git, so this
+# dir shouldn't be your working repo that you use for any other purpose.
+# This must be located on the same filesystem as $archivedir!
+$sbogitdir = "/home/urchlay/sbo-master/";
+
+# Branch to use, normally master (only change for testing purposes).
+#$sbogitbranch = "master"; $ TODO: implement
+
+# Location of archive (which you will serve by e.g. apache).
+# This must be located on the same filesystem as $sbogitdir!
+$archivedir = "/home/urchlay/sboarchive";
+
+# Max file size, in megabytes (real ones, 2**10). Doesn't have to be an
+# integer. Set to 0 for "no limit". Files larger than this (according to
+# HTTP HEAD or FTP SIZE) won't be downloaded. If you increase this, re-run
+# 'sbosrcarch create' after editing this config. If you decrease it,
+# run 'sbosrcarch trim' to get rid of files that are now over the limit.
+$maxfilemegs = 0.1;
+
+# 0 = use hard links for by-md5 tree, 1 = symlinks.
+# Which should you use? Well, if other people are going to rsync your
+# repo, hardlinks are more expensive (see the -a and -H options
+# in the rsync man page). If disk space is at a premium, symlinks
+# eat a tiny bit more space (but I mean *tiny*)... and you'll have to
+# make sure your web server follows symlinks if you use them.
+# TODO: implement this! For now, only hard links are supported.
+$symlinks = 0;
+
+# Extra arguments to pass to wget. We're already creating a config file
+# and using it in place of .wgetrc and /etc/wgetrc, you don't need to
+# list --config here.
+$wgetargs = "";
+
+# We don't trust the system-wide or user wgetrc, so we provide our own.
+# The check_certificate = off might be controversial. My take on it is
+# that it's better to download the file even if the server has a crappy
+# self-signed certificate.
+# Might want to add this here:
+#timeout = 30
+$wgetrc_contents = <<EOF;
+robots = off
+user_agent = Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)
+check_certificate = off
+content_disposition = off
+EOF
+
+# Most download sites work better if the HTTP user agent header is
+# set to a normal browser (see $wgetrc_contents above). But some sites
+# "helpfully" redirect to an HTML page if using a browser, so list them
+# here.
+%user_agent_overrides = (
+		qr/(?:sourceforge|sf)\.net/ => 'wget',
+);
+
+#### end of config, code follows
+
+# use only modules that ship with Slackware
+use File::Temp qw/tempfile tempdir/;
+use File::Find;
+use Digest::MD5;
+use Net::FTP;
+use POSIX 'getcwd';
+
+# url_to_filename, gets the filename part of a URL (after the last slash)
+# and un-escapes any %XX sequences.
+sub url_to_filename {
+	my $u = shift;
+	$u =~ s,.*/,,;
+	$u =~ s,%([0-9A-F]{2}),chr(hex($1)),ge;
+	return $u;
+}
+
+# parse a single .info file, return a hashref where keys = URL(s)
+# and values are their md5sums.
+sub parse_info {
+	local $/ = "";
+	my $file = shift;
+	open my $fh, "<", $file;
+	my $got = <$fh>;
+
+	$got =~ s/\\\s*\n//gs; # join \ continuation lines
+	$got =~ s/[ \t]+/ /g;  # condense whitespace
+
+	$got =~ /DOWNLOAD(?:_x86_64)?="([^"]+)"/;
+	my @urls = split " ", $1;
+
+	$got =~ /MD5SUM(?:_x86_64)?="([^"]+)"/;
+	my @md5s = split " ", $1;
+
+	my %ret;
+	for(@urls) {
+		next if /^un(test|support)ed$/;
+		$ret{$_} = shift @md5s;
+	}
+
+	return \%ret;
+}
+
+# the download_* subs return:
+# 0 - file too big (so skip it)
+# positive integer - file size
+# undef - download error (404, failed DNS, etc).
+# FIXME: the above isn't really true, and the calling code doesn't
+# check the return values as it should.
+
+sub download_http {
+	my $url = shift;
+	my $size = wget($url, 1); # HEAD request first
+
+	# $size will be 0 for 'too big' or undef if the HEAD failed.
+
+	if($size) {
+		$size = wget($url, 0);
+	}
+	return $size;
+}
+
+sub download_file {
+	my $url = shift;
+	my $filename = url_to_filename($url);
+
+	my $dlresult;
+	if($url =~ /^ftp:/) {
+		$dlresult = download_ftp($url);
+	} else {
+		$dlresult = download_http($url);
+	}
+
+	return $dlresult;
+}
+
+# see %user_agent_overrides
+sub user_agent {
+	my $url = shift;
+
+	my $ua = "";
+	$url =~ m,^\w+://([^/]*)/,;
+	my $site = $1;
+	for (keys %user_agent_overrides) {
+		$site =~ /$_/ && do {
+			$ua = $user_agent_overrides{$_};
+		};
+	}
+	$ua = "--user-agent='$ua'" if $ua;
+	return $ua;
+}
+
+# return true if limit set and file size > limit.
+# return false if no limit set, or file size <= limit.
+sub toobig {
+	return 0 if $maxfilemegs <= 0; # no limit
+	return $_[0] > ($maxfilemegs * 1024 * 1024);
+}
+
+# wget_fake_head: What is a fake HEAD request?
+
+# Stoopid github "cloud" bullshit (actually, amazonaws.com) doesn't
+# allow HEAD requests, so we fake them by doing a GET, then closing the
+# connection as soon as we've got the headers.
+
+# Due to buffering, wget still downloads the first 16K or so of the file,
+# which gets discarded when we close its filehandle. We could do better
+# than this by implementing the HTTP protocol in terms of IO::Socket::INET
+# or such, but I'm not writing & debugging the mess that would turn into.
+
+# This gets called for any URL that doesn't return a Content-Length header
+# in its HEAD request (for whatever reason, including because of a 404
+# not found). Of course, a GET might not return a length header either :(
+
+sub wget_fake_head {
+	my $url = shift;
+	my $cmd = "wget --config=$wgetrc " .
+		"--quiet -O- --save-headers " .
+		user_agent($url) . " " .
+		" $wgetargs " .
+		"'$url'";
+
+	print "real HEAD failed, trying fake HEAD request: $cmd\n";
+
+	my $size;
+	open my $fh, "$cmd|" or return undef;
+	while(<$fh>) {
+		s/\r//;
+		chomp;
+		last if /^$/;
+		$size = $1 if /^Content-Length:\s+(\d+)/;
+	}
+	close $fh;
+
+	if($size && toobig($size)) {
+		printf "file too large: %0.2fMB\n", $size / (1024 * 1024);
+		$skipcount++;
+		$size = 0;
+	}
+
+	return $size;
+}
+
+sub wget {
+	my $url = shift;
+	my $head = shift; # boolean, 0 = download (GET), 1 = HEAD request only
+
+	my $size;
+
+	# XXX: respect environment's $TMP or such?
+	if(not defined $wgetrc) {
+		($fh, $wgetrc) = tempfile("wgetrc.XXXXXXXX", DIR => "/tmp", UNLINK => 1);
+		print $fh $wgetrc_contents;
+		close $fh;
+	}
+
+	my $outfile;
+	($fh, $outfile) = tempfile("wget.out.XXXXXXXX", DIR => "/tmp", UNLINK => 1);
+	close $fh;
+
+	my $cmd = "wget --config=$wgetrc " .
+		user_agent($url) . " " .
+		($head ? "--spider --tries 1" : "") .
+		" $wgetargs " .
+		"'$url' " .
+		">$outfile 2>&1";
+
+		#" --referer='$url' " . # don't use, it breaks sourceforge
+
+	print "$cmd\n";
+	my $retval = system($cmd);
+
+	open $fh, "<$outfile";
+	while(<$fh>) {
+		print " ! $_" if $retval != 0;
+
+		/^Length:\s*(\d+).*\[(.*?)\]/ && do {
+			$size = $1; # $content_type = $2;
+			if(toobig($size)) {
+				printf "file too large: %0.2fMB\n", $size / (1024 * 1024);
+				$skipcount++;
+				$size = 0;
+			}
+		};
+	}
+	close $fh;
+	unlink $outfile;
+
+	# Grr. Some sites refuse HEAD requests, and some allow them but
+	# don't return a Content-Length header. So we must resort to more
+	# drastic measures.
+	# FIXME: don't bother doing this if we got 404 (not found) from the HEAD,
+	# or stuff like DNS errors.
+	if($head && not(defined($size))) {
+		return wget_fake_head($url);
+	}
+
+	return $size; # which might be undef!
+}
+
+# we could use wget for FTP links too, but doing it this way
+# lets us check the filesize and do the download with only one
+# FTP session.
+sub download_ftp {
+	my ($server, $dir, $filename) = ($_[0] =~ m,
+		^ftp://   # proto
+		([^/]+)   # server (no slashes)
+		(/.*?)?   # optional path (always at least the initial slash)
+		([^/]+)$  # filename (everything after last slash)
+		,x);
+
+	print "using Net::FTP to get $_[0]\n";
+	my $size = undef;
+	eval {
+		my $ftp = Net::FTP->new($server, Debug => 0)
+			or die "Can't connect to $server: $@";
+		$ftp->login("anonymous",'-anonymous@')
+			or die "Can't log in to $server: ", $ftp->message;
+		$ftp->cwd($dir)
+			or die "Can't chdir($dir) on $server: ", $ftp->message;
+		$ftp->binary;
+		$size = $ftp->size($filename)
+			or die "Can't get $filename size from $server: ", $ftp->message;
+
+		if(toobig($size)) {
+			printf "file too large: %0.2fMB\n", $size / (1024 * 1024);
+			$skipcount++;
+			$size = 0;
+		} else {
+			$ftp->get($filename)
+				or die "Can't download $filename from server: ", $ftp->message;
+		}
+
+		$ftp->quit;
+	};
+
+	if($@) {
+		print "$_[0]: $@";
+		$size = 0;
+	}
+
+	return $size;
+}
+
+sub git_clone {
+	system("git clone $sbogiturl $sbogitdir");
+}
+
+sub git_pull {
+	return !system("git pull");
+}
+
+sub md5_dir {
+	my $md5 = shift;
+	return "$archivedir/by-md5/" .
+		substr($md5, 0, 1) .
+		"/" .
+		substr($md5, 1, 1) .
+		"/" .
+		$md5 .
+		"/";
+}
+
+sub name_dir {
+	my ($cat, $prg) = @_;
+	return "$archivedir/by-name/$cat/$prg/";
+}
+
+sub md5sum_file {
+	my $filename = shift;
+	open my $fh, "<", $filename; # XXX: error check (don't use die)
+	binmode($fh);
+	my $ret = Digest::MD5->new->addfile($fh)->hexdigest;
+	close $fh;
+	return $ret;
+}
+
+sub already_exists {
+	my ($filename, $category, $prgnam, $md5) = @_;
+
+	my $n = name_dir($category, $prgnam) . "/" . $filename;
+	my $m = md5_dir($md5) . "/" . $filename;
+
+	return
+		-e $n &&
+		-e $m &&
+		($md5 eq md5sum_file($n)) &&
+		($md5 eq md5sum_file($n));
+}
+
+# TODO: handle %20 => space (and other URL encodings)
+# ...needs to be done elsewhere too, not just here.
+sub store_file {
+	my ($filename, $category, $prgnam, $md5) = @_;
+
+	#warn "store_file($filename, $category, $prgnam, $md5);\n";
+
+	system("mkdir -p " . md5_dir($md5));
+	system("mkdir -p " . name_dir($category, $prgnam));
+	link($filename, name_dir($category, $prgnam) . "/" . $filename);
+	warn "symlinks not yet supported, using hardlink instead\n" if $symlinks;
+	link($filename, md5_dir($md5) . "/" . $filename); # TODO: symlink option
+}
+
+# handle_info_file() is used as the 'wanted' sub for File::Find, but
+# it's also called from add and update modes, so it doesn't use any of
+# the File::Find stuff. Call while cd'ed to $sbogitdir, with $_ set to
+# the relative path to the .info file.
+sub handle_info_file {
+	return unless /\.info$/;
+
+	my $dls = parse_info("$_");
+
+	s,^\./,,; # strip leading ./, if present
+	my ($category, $prgnam) = split /\//, $_;
+	print "=== $category/$prgnam: ";
+
+	for(keys %$dls) {
+		$urlcount++;
+		my $url = $_;
+		my $md5 = $dls->{$_};
+		my $filename = url_to_filename($url);
+
+		if(already_exists($filename, $category, $prgnam, $md5)) {
+			print "already in archive, OK\n";
+			$archivecount++;
+		} else {
+			$attemptcount++;
+			download_file($url); # TODO: check result!
+			if(! -f $filename) {
+				$failcount++;
+				print "$filename not downloaded\n";
+				next;
+			}
+
+			if(md5sum_file($filename) ne $md5) {
+				$failcount++;
+				print "md5sum failed for $url";
+				unlink($filename);
+				next;
+			}
+
+			print "downloaded, OK\n";
+			$archivecount++;
+			$dlcount++;
+			store_file($filename, $category, $prgnam, $md5);
+			unlink($filename);
+		}
+	}
+}
+
+sub init_git {
+	chdir($sbogitdir) && -d ".git" ||
+		die "SBo git dir $sbogitdir not a git checkout, " .
+			"do you need to run 'sbosrcarch create?'\n";
+}
+
+sub create_mode {
+	chdir($sbogitdir) or git_clone;
+	chdir($sbogitdir) or die "can't find or create SBo git dir $sbogitdir\n";
+	git_clone unless -d ".git";
+	git_pull or die "git pull failed, check $sbogitdir\n";
+
+	$skipcount = $attemptcount = $urlcount =
+	$archivecount = $dlcount = $failcount = $nowarchived = 0;
+
+	find({wanted => \&handle_info_file, no_chdir => 1}, ".");
+
+	$nowarchived = $dlcount + $archivecount;
+	$coverage = sprintf("%.1d", ($nowarchived * 100 / $urlcount));
+	print <<EOF;
+
+---
+Total URLs: $urlcount
+Already archived: $archivecount
+Skipped downloads due to size limit: $skipcount
+Attempted downloads: $attemptcount
+Successful downloads: $dlcount
+Failed downloads: $failcount
+Now archived: $nowarchived
+Coverage: $coverage%
+EOF
+}
+
+sub update_mode {
+	my $oldcommit;
+
+	init_git();
+
+	open my $fh, "git log|" or die "$!";
+	my $logline = <$fh>;
+	(undef, $oldcommit) = split /\s+/, $logline;
+	print "git repo was at commit $oldcommit\n";
+	close $fh;
+
+	git_pull();
+
+	open $fh, "git diff --numstat $oldcommit|" or die "$!";
+	while(<$fh>) {
+		(undef, undef, $_) = split /\s+/;
+		next unless /\.info$/;
+		handle_info_file();
+	}
+	exit 0;
+}
+
+# purge_mode() does 3 passes.
+# 1. get all the filenames from all the info files, build a hash of filenames.
+# 2. walk the archive tree with File::Find and rm any file that's in a
+#    category/name dir, but not mentioned in the filename hash (also, rm its
+#    md5_dir() counterpart).
+# 3. do a trim_post() pass to delete any empty dirs and/or dangling symlinks
+
+# FIXME: files from different URLs but with the same filename will not be
+# purged when they should, because the comparison is solely filename-based!
+sub purge_mode {
+	init_git();
+
+	$purgebytes = $purgefiles = 0;
+
+	# pass 1
+	%keep_filenames = (); # populated by the find():
+	find({wanted => \&purge_pass_1_wanted, no_chdir => 1}, ".");
+
+#	for(keys %keep_filenames) {
+#		warn "keep $_\n";
+#	}
+
+	# pass 2
+	chdir($archivedir) or die "$archivedir: $!\n";
+	find({wanted => \&purge_pass_2_wanted, no_chdir => 1}, "by-name");
+
+	# pass 3
+	trim_post();
+
+	printf("Purged $purgefiles files, %.1fMB\n", ($purgebytes / (1024 * 1024)));
+	exit 0;
+}
+
+# helper for purge_mode, populates %keep_filenames
+sub purge_pass_1_wanted {
+	return unless /\.info$/;
+	my $dls = parse_info($_);
+	for(keys %$dls) {
+		$_ = url_to_filename($_);
+		$keep_filenames{$_}++;
+	}
+}
+
+# helper for purge_mode, removes all files in category/prgnam/
+# dirs that aren't listed in %keep_filenames
+sub purge_pass_2_wanted {
+	s,^\./,,; # remove leading ./
+	my (undef, $cat, $name, $file) = split /\//, $_;
+	return unless defined $file;
+	return if $keep_filenames{$file};
+
+	print "purge $_\n";
+	$purgebytes += -s $_;
+	$purgefiles++;
+
+	unlink md5_dir(md5sum_file($_)). "$file";
+	unlink $_;
+}
+
+# helper for trim_mode
+sub trim_wanted {
+	return unless -f $_;
+	my $size = -s _;
+	if(toobig($size)) {
+		unlink($_);
+		$trimcount++;
+		$trimbytes += $size;
+	}
+}
+
+# helper for trim_post
+sub trim_post_wanted {
+	unlink $_ if -l $_ && ! -e _;
+	return unless -d _;
+	push @trim_empty_dirs, $_ if !<*>;
+}
+
+# pass 2 of trim_mode, also called by purge_mode. removes
+# empty directories and dangling symlinks.
+sub trim_post {
+	chdir($archivedir) or die "$archivedir: $!\n";
+
+	# can't rmdir from within find's wanted sub, or we get
+	# lots of 'Can't opendir()' warnings. So collect all the
+	# empty dirs in an array during the find, then rmdir them
+	# all in one swell foop afterwards.
+	@trim_empty_dirs = ();
+
+	# remove dangling symlinks and make a list of empty dirs
+	find({wanted => \&trim_post_wanted, no_chdir => 1}, ".");
+
+	rmdir $_ for @trim_empty_dirs; # the aforementioned swell foop
+}
+
+# this mode doesn't know/care about the git stuff, it operates purely
+# on the archive file tree.
+sub trim_mode {
+	chdir($archivedir) or die "$archivedir: $!\n";
+
+	$trimcount = $trimbytes = 0;
+
+	# first pass: remove files that are too big
+	find({wanted => \&trim_wanted, no_chdir => 1}, ".");
+
+	# 2nd pass
+	trim_post();
+
+	printf("Trimmed $trimcount files, %.1fMB\n", ($trimbytes / (1024 * 1024)));
+	exit 0;
+}
+
+# in: "category/name"
+# out: "category/name/name.info"
+sub find_info_file {
+	my $info = shift;
+	$info =~ s,/([^/]+)$,/$1/$1.info,;
+	return $info;
+}
+
+# FIXME: this will fail if @localfiles are absolute paths!
+sub local_add {
+	my ($oldcwd, $catname, $info, @localfiles) = @_;
+	$catname =~ s,^\./,,;
+	my ($category, $prgnam) = split /\//, $catname;
+	my %localmd5s;
+
+	for(@localfiles) {
+		$localmd5s{md5sum_file("$oldcwd/$_")} = "$oldcwd/$_";
+	}
+
+	my $dls = parse_info($info);
+
+	chdir($archivedir) or die "$archivedir: $!";
+	for(keys %$dls) {
+		my $targetfile = url_to_filename($_);
+
+		my $md5 = $dls->{$_};
+		my $localfile = $localmd5s{$md5};
+		next unless $localfile;
+
+		delete $localmd5s{$md5};
+
+		system("cp \"$localfile\" \"./$targetfile\"");
+		store_file($targetfile, $category, $prgnam, $md5);
+		unlink($targetfile);
+	}
+
+	for(keys %localmd5s) {
+		print "$localmd5s{$_} ($_) ignored: doesn't match any md5sum in $info\n";
+	}
+
+	exit 0;
+}
+
+sub add_or_rm_mode {
+	my $oldcwd = POSIX::getcwd();
+	init_git();
+	my $mode = shift @ARGV;
+	my $catname = shift @ARGV or usage();
+
+	if($catname eq '-f') {
+		$maxfilemegs = 0;
+		$catname = shift(@ARGV) or usage();
+	}
+
+	my $info = find_info_file($catname);
+	if(! -f $info) {
+		die "Can't find $info in repo\n";
+	}
+
+	if($mode eq "add") {
+		if(!@ARGV) { # no args, use URL(s) in .info file
+			$_ = $info;
+			handle_info_file();
+			exit 0;
+		} else {
+			local_add($oldcwd, $catname, $info, @ARGV);
+		}
+	} elsif($mode eq "rm") {
+		my $dls = parse_info($info);
+		for(keys %$dls) {
+			my $md5 = $dls->{$_};
+			my $filename = url_to_filename($_);
+			my ($category, $prgname) = split /\//, $catname;
+			unlink(name_dir($category, $prgname) . "/$filename");
+			rmdir(name_dir($category, $prgname));
+			unlink(md5_dir($md5) . "/$filename");
+			rmdir(md5_dir($md5));
+			exit 0;
+		}
+	} else {
+		die "this never happens";
+	}
+}
+
+sub usage {
+	my $self = $0;
+	$self =~ s,.*/,,;
+
+	print <<EOF;
+$self - create and maintain SBo source archive
+
+Usage: $self <mode>
+
+<mode> is one of:
+
+  create
+  update
+  purge
+  add <category/prgname> [<file> ...]
+EOF
+
+	exit 1
+}
+
+#main()
+
+usage() unless defined $ARGV[0];
+for ($ARGV[0]) {
+	/create/ && do { create_mode();    };
+	/update/ && do { update_mode();    };
+	/purge/  && do { purge_mode();     };
+	/add/    && do { add_or_rm_mode(); };
+	/rm/     && do { add_or_rm_mode(); };
+	/trim/   && do { trim_mode();      };
+	usage();
+}
+
+__END__
+
+notes:
+
+Update repo & show only .info files that have changed:
+oldhash=$( git log | head -1 | cut -d' ' -f2 )
+git pull
+git diff --numstat $oldhash | cut -f3 | grep '\.info$'
+
+bugs/limitations: plenty, see FIXME TODO XXX comments in the code. Here
+are some that I'm not planning to address any time soon:
+
+No threading. Not likely to change. It would be possible to spawn wget
+processes in the background, but I'm not going to complicate it that way.
+
+Anything that checks referer header or otherwise tries to stop automated
+downloads, will stop us. This isn't really a bug (sbopkg can't handle them
+either).
+
+Length: unspecified isn't handled (we just don't download these). Specifically,
+dropbox URLs do this.
+
+$sbogitdir and $archivedir must be located on the same filesystem, as files
+are moved around by linking them.
+
+github.com download URLs don't allow HEAD requests. Not sure the best way to
+handle this just yet.