Added slackware repository metadata generator

+ Added slackware repository metadata generator
+ Added deps to cpanfile
* Fixed sample config

cpanfile

@@ -9,3 +9,5 @@ requires 'Net::LibIDN';
 requires 'Plack';
 requires 'Telegram::Bot';
 requires 'URI::URL';
+requires 'Compress::Raw::Bzip2';
+requires 'Compress::Raw::Zlib';

data/myapi.json.sample

@@ -8,7 +8,7 @@
     },
     "upload" : {
         "dir" : {
-            "mydir" : "/data/upload",
+            "mydir" : "/data/upload"
         },
         "auth": "iliveoncemore"
     },
@@ -41,5 +41,9 @@
         "name" : "gozerbot",
         "token" : "botfather:token",
         "brain": "./data/gozerbot.telegram.sqlite"
-    }
+    },
+    "metagen" : {
+        "myslack" : "/var/www/repo/myslack",
+        "stuff" : "/var/www/repo/stuff"
+    },
 }

lib/metagen.pm

@@ -0,0 +1,248 @@
+# Most of this data is generated during package build process and being uploaded
+# to pool alongside with packages themselves. So we can easily and fast regen meta.
+
+# Assume that whole operation takes resonable amount of time to perform it syncronously
+
+# metadata consists of 
+# * CHECKSUMS.md5 or CHECKSUMS.md5.gz - checksum of each file in repo
+# * ChangeLog.txt - optional, contains history of changes, this script does not
+#                   handle it
+# * FILELIST.TXT - whole list of files that are part of repostory data or
+#                  metadata
+# * PACKAGES.TXT - packages description with metainfo such as relative path in
+#                  repo, compressed size and uncompressed size
+# * MANIFEST.bz2 - list of files in each package
+
+# TODO: make metadata in atomic way
+
+package metagen;
+
+use warnings "all";
+use strict;
+
+use Fcntl;
+use Compress::Raw::Bzip2 qw(BZ_RUN_OK BZ_STREAM_END);
+use Compress::Raw::Zlib;
+use POSIX qw(strftime);
+
+use conf;
+
+use Exporter qw(import);
+use vars qw/$VERSION/;
+$VERSION = "1.0";
+our @EXPORT = qw(metagen);
+
+sub metagen($);
+sub __pdate;        # generates current date in pretty format
+
+sub metagen($) {
+	my $dir = shift;
+# TODO: get dir from config!
+	my $c = loadConf();
+	$dir = $c->{metagen}->{$dir};
+
+	unless (defined($dir)) {
+		return ('400', 'text/plain',  "No such repository\n");
+	}
+
+	opendir(my $dh, $dir) or return  ('500', 'text/plain',  "Unable to read $dir : $!\n");
+	my @list;
+
+	while (readdir($dh)) {
+		next if ($_ eq '.');
+		next if ($_ eq '..');
+		push @list, $_;
+	}
+
+	closedir $dh;
+	@list = sort(@list);
+
+# manifest
+	my $manifest = '';
+	my $bz = new Compress::Raw::Bzip2 1, 9, 0;
+
+	unless (defined($bz)) {
+		return  ('500', 'text/plain',  "Unable to create bz object\n");
+	}
+
+	my $output;
+
+	foreach my $str (@list) {
+		if ($str =~ /\.lst/) {
+			open (F, '<', "$dir/$str") or return  ('500', 'text/plain',  "Unable to open file $dir/$str: $!\n");
+			my $sep = $/; $/ = undef;
+			my $buf = <F> . "\n";
+
+			if ($bz->bzdeflate($buf, $output) != BZ_RUN_OK) {
+				return  ('500', 'text/plain',  "Unable to perofrm bzip2 compression\n");
+			}
+
+			if ($bz->bzflush($output) != BZ_RUN_OK) {
+				return  ('500', 'text/plain',  "Unable to flush bz buffer\n");
+			}
+
+			$/ = $sep; undef $sep;
+			close F;
+		}
+	}
+
+	if ($bz->bzclose($output) != BZ_STREAM_END) {
+		return  ('500', 'text/plain',  "Unable to flush and close bz buffer\n");
+	}
+
+	$bz = '';
+	sysopen(BZ, "$dir/MANIFEST.bz2", O_WRONLY|O_TRUNC|O_CREAT) or return  ('500', 'text/plain',  "Unable to open $dir/MANIFEST.bz2: $!\n");
+	binmode(BZ);
+	syswrite BZ, $output;
+	close BZ;
+	$output = '';
+
+# checksums
+	my $buffer = 'These are the MD5 message digests for the files in this directory.
+If you want to test your files, use \'md5sum\' and compare the values to
+the ones listed here.
+
+To test all these files, use this command:
+
+tail +13 CHECKSUMS.md5 | md5sum --check | less
+
+\'md5sum\' can be found in the GNU coreutils package on ftp.gnu.org in
+/pub/gnu, or at any GNU mirror site.
+
+MD5 message digest                Filename
+';
+
+	foreach my $str (@list) {
+		next if ($str =~ /CHECKSUMS\.md5$/);
+		next if ($str =~ /CHECKSUMS.md5.gz$/);
+
+		if ($str =~ /\.md5/) {
+			sysopen (F, "$dir/$str", O_RDONLY) or return  ('500', 'text/plain',  "Unable to open file $dir/$str: $!\n");
+			$buffer .= <F>;
+			close F;
+		}
+	}
+
+	sysopen (CS, "$dir/CHECKSUMS.md5", O_WRONLY|O_TRUNC|O_CREAT) or return  ('500', 'text/plain',  "Unable to open file $dir/CHECKSUMS.md5: $!\n");
+	syswrite CS, $buffer;
+	close CS;
+	$buffer = '';
+
+	my $gz = new Compress::Raw::Zlib::Deflate (
+		-Level => Z_BEST_COMPRESSION,
+		-CRC32 => 1,
+		-ADLER32=> 1,
+		-WindowBits => WANT_GZIP
+	);
+
+	unless (defined($gz)) {
+		return  ('500', 'text/plain',  "Unable to create gz object\n");
+	}
+
+	if ($gz->deflate($buffer, $output) != Z_OK) {
+		return  ('500', 'text/plain',  "Unable to deflate\n");
+	}
+
+	if ($gz->flush($output) != Z_OK) {
+		return  ('500', 'text/plain',  "Unable to flush gz object\n");
+	}
+
+	$gz = '';
+	sysopen (F, "$dir/CHECKSUMS.md5.gz", O_WRONLY|O_TRUNC|O_CREAT) or return  ('500', 'text/plain',  "Unable to open file $dir/CHECKSUMS.md5.gz\n");
+	binmode F;
+	syswrite F, $output;
+	close F;
+	$output = '';
+
+# packages
+	my $date = __pdate;
+	$buffer = "PACKAGES.TXT;  $date\n\n";
+
+	foreach my $str (@list) {
+		if ($str =~ /\.meta/) {
+			open (F, '<', "$dir/$str") or return  ('500', 'text/plain',  "Unable to open file $dir/$str: $!\n");
+
+			while(<F>) {
+				$buffer .= $_;
+			}
+
+			chomp $buffer;
+			close F;
+		}
+	}
+
+	sysopen (F, "$dir/PACKAGES.TXT", O_WRONLY|O_TRUNC|O_CREAT) or return  ('500', 'text/plain',  "Unable to open file $dir/PACKAGES.TXT: $!\n");
+	binmode F;
+	syswrite F, $buffer;
+	close F;
+	$buffer = '';
+
+	my $gz = new Compress::Raw::Zlib::Deflate (
+		-Level => Z_BEST_COMPRESSION,
+		-CRC32 => 1,
+		-ADLER32=> 1,
+		-WindowBits => WANT_GZIP
+	);
+
+	unless (defined($gz)) {
+		return  ('500', 'text/plain',  "Unable to create gz object\n");
+	}
+
+	if ($gz->deflate($buffer, $output) != Z_OK) {
+		return  ('500', 'text/plain',  "Unable to deflate\n");
+	}
+
+	if ($gz->flush($output) != Z_OK) {
+		return  ('500', 'text/plain',  "Unable to flush gz object\n");
+	}
+
+	$gz = '';
+	sysopen (F, "$dir/PACKAGES.TXT.gz", O_WRONLY|O_TRUNC|O_CREAT) or return  ('500', 'text/plain',  "Unable to open file $dir/PACKAGES.TXT.gz\n");
+	binmode F;
+	syswrite F, $output;
+	close F;
+	$output = '';
+
+	@list = -1;
+	@list = split(/\n/, `ls -lAn --time-style=long-iso "$dir"`);
+
+	@list = map {
+		my $str = $_;
+
+		if (length($str) > 45) {
+			substr($str, 44, 0, './');
+			$str = $str . "\n";
+		} else {
+			my $date = __pdate;
+			$str = "$date
+
+Here is the file list for this directory ,
+maintained by Eric Hameleers <alien\@slackware.com> .
+If you are using a mirror site and find missing or extra files
+in the subdirectories, please have the archive administrator
+refresh the mirror.
+
+";
+		}
+
+		$str;
+	} @list;
+
+	sysopen(F, "$dir/FILELIST.TXT", O_WRONLY|O_TRUNC|O_CREAT) or return  ('500', 'text/plain', "Unable to open $dir/FILELIST.TXT\n");
+	binmode F;
+	syswrite F, join('', @list);
+	close F;
+
+	return  ('200', 'text/plain', "Done\n");
+}
+
+sub __pdate {
+	my @time = gmtime(time);
+	my @DAYOFWEEK = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
+	my @MONTH = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Nov', 'Dec');
+	return strftime "$DAYOFWEEK[$time[6]] $MONTH[$time[4] - 1] %e %T UTC %Y", @time;
+}
+
+1;
+
+# vim: ft=perl noet ai ts=4 sw=4 sts=4:

myapi.psgi

@@ -11,6 +11,7 @@ use utils;
 use easter_egg;
 use upload;
 use image_dl;
+use metagen;
 use jabberbot;
 use threads;
 
@@ -20,7 +21,9 @@ if ($CONF->{api}->{prefix} eq '/') { $CONF->{api}->{prefix} = ''; }
 my $prefix = $CONF->{api}->{prefix};
 
 threads->create('image_dl_thread')->detach;
-threads->create('run_jabberbot')->detach;
+#threads->create('run_ircbot')->detach;
+#threads->create('run_jabberbot')->detach;
+#threads->create('run_telegrambot')->detach;
 
 my $app = sub {
 	my $env = shift;
@@ -89,6 +92,10 @@ EOL
 		}
 	} elsif ($env->{PATH_INFO} eq "$prefix/image_dl") {
 		($status, $content, $msg) = image_dl_queue($env->{HTTP_URL});
+	} elsif ($env->{PATH_INFO} eq "$prefix/metagen") {
+		if (defined($env->{HTTP_REPO})) {
+			($status, $content, $msg) = metagen($env->{HTTP_REPO});
+		}
 	}