Add .gitignore files

A file might be deleted between the time we read the directory and the
time we get around to check it, so if we can't lstat it, assume that is
what has happened. (It might also have been renamed, but that's
equivalent to this file being deleted and another being created, so we
don't have to treat this specially)

.gitignore

@@ -0,0 +1,3 @@
+GNUmakerules
+GNUmakevars
+*.o

agestat/GNUmakefile

@@ -5,7 +5,10 @@ BINDIR=/usr/local/bin
 all: agestat
 
 clean:
-	rm agestat customize
+	rm -f agestat customize
+
+distclean: clean
+	rm -f GNUmakevars GNUmakerules
 
 install: $(BINDIR) $(BINDIR)/agestat
 
@@ -23,4 +26,10 @@ customize: configure
 $(BINDIR):
 	mkdir -p $@
 
+GNUmakevars: GNUmakevars.sh
+	sh ./$^ > $@
+GNUmakerules: GNUmakerules.sh
+	sh ./$^ > $@
+
+
 include GNUmakerules

agestat/GNUmakerules.sh

@@ -0,0 +1,5 @@
+#!/bin/sh
+echo "\$(BINDIR)/%: %"
+echo "	cp \$^ \$@"
+echo "\$(MAN1DIR)/%: %"
+echo "	cp \$^ \$@"

agestat/GNUmakevars.sh

@@ -0,0 +1,15 @@
+#!/bin/sh
+prefix=${prefix:-/usr/local}
+echo "BINDIR=$prefix/bin"
+
+for i in "$prefix/share/man/man1" "$prefix/man/man1"
+do
+	if [ -d "$i" -a -w "$i" ]
+	then
+		echo "MAN1DIR=$i"
+		break;
+	fi
+done
+
+echo
+echo "all:"

agestat/agestat.pl

@@ -1,6 +1,6 @@
 #!@@@perl@@@ -w
 #
-# $Id: agestat.pl,v 1.4 2001-01-19 19:06:01 hjp Exp $
+# $Id: agestat.pl,v 1.10 2015-08-25 16:00:39 hjp Exp $
 #
 
 use strict;
@@ -8,11 +8,16 @@ use File::stat;
 use File::Find;
 use Getopt::Long;
 
-my $now = time();
-my $log_2 = log(2);
+sub usage {
+    print STDERR "Usage: $0 [-atime|-mtime] [-scale=(k|M)] [-buckets=(cal|log2)]\n";
+    exit 1;
+}
 
-my %opts = ();
-GetOptions(\%opts, "atime", "mtime", "scale=s");
+my $now = time();
+my @bucket_max;
+
+my %opts = (buckets => 'log2');
+GetOptions(\%opts, "atime", "mtime", "scale=s", "buckets=s") or usage();
 my $scale;
 if (!defined($opts{scale})) {
     $scale = 1;
@@ -21,44 +26,68 @@ if (!defined($opts{scale})) {
 } elsif ($opts{scale} eq 'M') {
     $scale = 1024*1024;
 } else {
-    print STDERR "Usage: $0 [-atime|-mtime] [-scale=(k|M)]\n";
-    exit 1;
+    usage();
 }
 
+if ($opts{buckets} eq "log2") {
+    for (my ($b, $s) = (0, 1); $b < 32; $b++, $s *= 2) {
+	$bucket_max[$b] = $s;
+    }
+} elsif ($opts{buckets} eq "cal") {
+    @bucket_max = (
+	3600,
+	86400,
+	7 * 86400,
+	30 * 86400,
+	182 * 86400,
+	1 * 365.2422 * 86400,
+	2 * 365.2422 * 86400,
+	3 * 365.2422 * 86400,
+	4 * 365.2422 * 86400,
+	5 * 365.2422 * 86400,
+    );
+} elsif ($opts{buckets} =~ /^days=(\d+)/) {
+    @bucket_max = map $_ * 86400, (1 .. $1);
+} else {
+    usage();
+}
+
+
 my @hist;
 
 sub wanted {
 
     my $st = lstat($_);
+    return unless $st;
     my $age = $now - (
 	$opts{atime} ? $st->atime :
 	$opts{mtime} ? $st->mtime :
-		       ($st->atime > $st->mtime ? $st->atime
+		       (! -d && $st->atime > $st->mtime ? $st->atime
 		                                        : $st->mtime ));
-    #print $File::Find::name, ": $age sec, ", $st->size, " bytes, ", $st->nlink, " links\n";
-    my $log2age = log($age >= 1 ? $age : 1) / $log_2;
-    $hist[$log2age] += $st->size / $st->nlink;
+    my $b = 0;
+    while ($b <= $#bucket_max && $age > $bucket_max[$b]) { $b++ };
+    #print $File::Find::name, ": $age sec, ", $st->size, " bytes, ", $st->nlink, " links, bucket $b\n";
+    $hist[$b] += $st->size / $st->nlink;
 }
 
-sub logtime2str {
-    my ($lt) = (@_);
-
-    my $t = 1 << $lt;
+sub time2str {
+    my ($t) = (@_);
 
     if ($t < 60) {
-	return sprintf ("%5.1f s", $t);
+	return sprintf ("%6.1f s", $t);
     } elsif ($t < 3600) {
-	return sprintf ("%5.1f m", $t/60);
+	return sprintf ("%6.1f m", $t/60);
     } elsif ($t < 3600 * 24) {
-	return sprintf ("%5.1f h", $t/3600);
+	return sprintf ("%6.1f h", $t/3600);
     } elsif ($t < 3600 * 24 * 365.2422) {
-	return sprintf ("%5.1f d", $t/(3600*24));
+	return sprintf ("%6.1f d", $t/(3600*24));
     } else {
-	return sprintf ("%5.1f y", $t/(3600*24*365.2422));
+	return sprintf ("%6.1f y", $t/(3600*24*365.2422));
     }
 }
 
 
+
 if (@ARGV == 0) { push (@ARGV, "."); }
 find(\&wanted, @ARGV);
 
@@ -75,12 +104,34 @@ my $c = 0;
 for (my $i = 0; $i <= $#hist; $i++) {
     my $h = ($hist[$i] || 0);
     $c += $h;
-    printf("%2d\t%s\t%12.0f\t%5.1f\t%12.0f\t%5.1f\n", $i,
-	   logtime2str($i), $h/$scale, $h * 100 / $sum, $c/$scale, $c * 100 / $sum);
+    printf("%2d\t%s\t%12.0f\t%5.1f\t%12.0f\t%5.1f\n",
+	   $i,
+	   $i <= $#bucket_max ? time2str($bucket_max[$i]) : "infinity",
+	   $h/$scale, $h * 100 / $sum, $c/$scale, $c * 100 / $sum);
 }
 
 # $Log: agestat.pl,v $
-# Revision 1.4  2001-01-19 19:06:01  hjp
+# Revision 1.10  2015-08-25 16:00:39  hjp
+# New bucket type days
+#
+# Revision 1.9  2012-10-22 09:20:05  hjp
+# fixed usage message
+#
+# Revision 1.8  2007-02-09 15:36:37  hjp
+# Automatically create GNUmakerules and GNUmakevars if they don't exist.
+# Print usage if unknown option is given.
+#
+# Revision 1.7  2006/02/17 13:50:23  hjp
+# Fixed error when oldest file was older than oldest bucket.
+# Realigned columns.
+#
+# Revision 1.6  2006/02/17 13:31:41  hjp
+# Added option --buckets.
+#
+# Revision 1.5  2002/03/18 20:33:46  hjp
+# Ignore atime for directories
+#
+# Revision 1.4  2001/01/19 19:06:01  hjp
 # Removed superfluous "total" line.
 # Fixed usage message.
 #

base64/GNUmakefile

@@ -0,0 +1,13 @@
+include GNUmakevars
+include GNUmakerules
+
+base64: base64.o
+	$(CC) $^ -lant -o $@
+
+clean:
+	rm -f *.o base64 core foo bar
+
+install: $(BINDIR)/base64
+
+distclean: clean
+	rm -f *.bak *.d

base64/base64.c

@@ -0,0 +1,55 @@
+#include <ant/base64.h>
+#include <unistd.h>
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+char *cmnd;
+
+static void usage(void) {
+    fprintf(stderr, "Usage: %s [-d|-e]\n", cmnd);
+    exit(1);
+}
+
+int main(int argc, char **argv) {
+    char buf1[1024+1];
+    char buf2[1024+1];
+    enum { NONE, ENCODE, DECODE} mode = NONE;
+    int c;
+    int r1, r2;
+    cmnd = argv[0];
+    while ((c = getopt(argc, argv, "de")) != EOF) {
+	switch(c) {
+	    case 'd':
+		mode = DECODE;
+		break;
+	    case 'e':
+		mode = ENCODE;
+		break;
+	    case '?':
+		usage();
+	    default:
+		assert(0);
+	}
+    }
+    switch(mode) {
+	case NONE:
+	    usage();
+	case ENCODE:
+	    while ((r1 = fread(buf1, 1, 57, stdin)) > 0) {
+		r2 = base64_encode(buf2, sizeof(buf2), buf1, r1, 76);
+		fwrite(buf2, 1, r2, stdout);
+		putchar('\n');
+	    }
+	    break;
+	case DECODE:
+	    while (fgets(buf1, sizeof(buf1), stdin)) {
+		r1 = strlen(buf1);
+		if (buf1[r1-1] == '\n') r1--;
+		r2 = base64_decode(buf2, sizeof(buf2), buf1, r1);
+		fwrite(buf2, 1, r2, stdout);
+	    }
+    }
+    return 0;
+}

charhist/.gitignore

@@ -0,0 +1 @@
+charhist

charhist/GNUmakefile

@@ -3,8 +3,19 @@ include GNUmakerules
 
 all: charhist
 
+charhist: charhist.pl
+	cp $^ $@
+
 chartab:
 clean:
 	rm -f charhist core foo bar baz
 
+distclean: clean
+	rm -f GNUmakerules GNUmakevars
+
+GNUmakevars: GNUmakevars.sh
+	sh ./$^ > $@
+GNUmakerules: GNUmakerules.pl
+	perl ./$^ > $@
+
 install: $(BINDIR)/charhist

charhist/GNUmakerules.pl

@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+print "\$(BINDIR)/%: %\n";
+print "\tinstall -m 755 \$^ \$@\n";
+print "\$(MAN1DIR)/%: %\n";
+print "\tinstall -m 644 \$^ \$@\n";

charhist/GNUmakevars.sh

@@ -0,0 +1,5 @@
+#!/bin/sh
+prefix=${prefix:-/usr/local}
+echo "BINDIR=$prefix/bin"
+echo
+echo "all:"

charhist/charhist.pl

@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use autodie;
+
+use Getopt::Long;
+use I18N::Langinfo qw(langinfo CODESET);
+use Pod::Usage;
+
+my $encoding = langinfo(CODESET);
+
+GetOptions('encoding=s', \$encoding) or pod2usage();
+
+my %hist;
+if (@ARGV) {
+    readfile($_) for @ARGV;
+} else {
+    readfile();
+}
+
+my $total = 0;
+$total += $_ for values %hist;
+
+binmode STDOUT, ":encoding(UTF-8)";
+for (sort keys %hist) {
+    my $cp = ord;
+    printf("%x\t%d\t%o\t%s\t%7d\t%f\n",
+           $cp, $cp, $cp, /\p{Graph}/ ? $_ : ".", $hist{$_}, $hist{$_} / $total);
+}
+
+sub readfile {
+    my ($filename) = @_;
+    my $fh;
+    if (defined $filename) {
+        open $fh, "<", $filename;
+    } else {
+        $fh = \*STDIN;
+
+    }
+    binmode $fh, ":encoding($encoding)";
+    while (<$fh>) {
+        for my $c (split(//)) {
+            $hist{$c}++;
+        }
+    }
+}

chartab/chartab.pl

@@ -0,0 +1,28 @@
+#!/usr/bin/perl 
+use warnings;
+use strict;
+use charnames ();
+
+use Getopt::Long;
+use Pod::Usage;
+
+my $all;
+
+GetOptions(
+    'all' => \$all
+) or pod2usage(2);
+
+binmode STDOUT, ":encoding(UTF-8)";
+for my $c (0 .. 0xFFFF) {
+    my $cc = pack('U', $c);
+    if (charnames::viacode($c) || $all) {
+	printf("%04x %5d %06o %s %s\n",
+	       $c,
+	       $c,
+	       $c,
+	       (($cc =~ /[[:print:]]/) ? $cc : '.'),
+	       charnames::viacode($c) || ''
+	);
+    }
+}
+print "\n";

cleandir/GNUmakefile

@@ -1,6 +1,6 @@
 include GNUmakevars
 
-TARGETS = cleandir
+TARGETS = cleandir cleandir.1
 CONFDIR=../../configure
 CONFDIR_exists=$(shell [ -d $(CONFDIR) ] && echo ok)
 
@@ -12,7 +12,10 @@ clean:
 distclean: clean
 	rm -f customize
 
-install: $(BINDIR) $(BINDIR)/cleandir
+install: $(BINDIR) $(BINDIR)/cleandir $(MAN1DIR)/cleandir.1
+
+%.1: %.pl
+	pod2man $< > $@
 
 %: %.pl customize
 	sh ./customize < $< > $@
@@ -35,5 +38,10 @@ configure: $(CONFDIR)/start $(CONFDIR)/perl $(CONFDIR)/finish
 
 endif
 
+GNUmakevars: GNUmakevars.sh
+	sh ./$^ > $@
+GNUmakerules: GNUmakerules.sh
+	sh ./$^ > $@
+
 
 include GNUmakerules

cleandir/GNUmakerules.sh

@@ -0,0 +1,5 @@
+#!/bin/sh
+echo "\$(BINDIR)/%: %"
+echo -e "\tcp \$^ \$@"
+echo "\$(MAN1DIR)/%: %"
+echo -e "\tcp \$^ \$@"

cleandir/GNUmakevars.sh

@@ -0,0 +1,15 @@
+#!/bin/sh
+prefix=${prefix:-/usr/local}
+echo "BINDIR=$prefix/bin"
+
+for i in "$prefix/share/man/man1" "$prefix/man/man1"
+do
+	if [ -d "$i" -a -w "$i" ]
+	then
+		echo "MAN1DIR=$i"
+		break;
+	fi
+done
+
+echo
+echo "all:"

cleandir/cleandir

@@ -1,131 +0,0 @@
-#!/usr/bin/perl -w
-use strict;
-use File::stat;
-use POSIX;
-
-my $verbose = 0;
-my $nop = 0;
-
-sub usage {
-    print STDERR "Usage: $0 [-d days] dir ...\n";
-    exit(1);
-}
-
-sub cleandir {
-    my ($dir, $since, $level) = (@_);
-    my $notremoved = 0;
-
-    if ($verbose > 1) {
-	print STDERR "$0:", " " x $level, " cleandir $dir $since {\n";
-    }
-    if (!opendir(DIR, ".")) {
-	printf STDERR "$0:", " " x $level, " cannot opendir $dir: $!";
-	return;
-    }
-    my $std = lstat(".");
-    for my $i (readdir(DIR)) {
-	if ($i eq "." || $i eq "..") {next}
-	if ($verbose > 2) {
-	    print STDERR "$0:", " " x $level, " checking $dir/$i\n";
-	}
-	my $st = lstat("$i");
-	if ($verbose > 3) {
-	    print STDERR "$0:", " " x $level, " mtime=", $st->mtime, " atime=", $st->atime, "\n";
-	}
-	if (-d _) {
-	    my $cwd = getcwd();
-	    if (chdir($i)) {
-		my $remaining = -1;
-		my $st1 = lstat(".");
-		if ($st->dev == $st1->dev && $st->ino == $st1->ino) {
-		    $remaining = cleandir("$dir/$i", $since, $level+1);
-		} else {
-		    print STDERR "$0:", " " x $level,
-		    		 " $dir/$i changed dev/inode from ",
-				 $st->dev, "/", $st->ino,
-				 " to ",
-				 $st1->dev, "/", $st1->ino,
-				 "\n";
-		}
-		chdir($cwd);
-		my $std1 = lstat(".");
-		if (!($std->dev == $std1->dev && $std->ino == $std1->ino)) {
-		    print STDERR "$0:", " " x $level,
-		    		 " $cwd changed dev/inode from ",
-				 $std->dev, "/", $std->ino,
-				 " to ",
-				 $std1->dev, "/", $std1->ino,
-				 "\n";
-		}
-		if ($remaining == 0 && $st->mtime < $since) {
-		    if ($verbose > 0) {
-			print STDERR "$0:", " " x $level, "rmdir $i\n";
-		    }
-		    if (rmdir("$i")) {next}
-		    print STDERR "$0:", " " x $level, "rmdir $i failed: $!\n";
-		} 
-	    } else {
-		print STDERR "$0:", " " x $level, " chdir $dir/$i failed: $!\n";
-	    }
-	    
-	} elsif ($st->mtime < $since && $st->atime < $since) {
-	    if ($nop) {
-		print "would remove $dir/$i\n";
-	    } else {
-		if ($verbose > 0) {
-		    print STDERR "$0:", " " x $level, " removing $dir/$i\n";
-		}
-		if (unlink("$i")) {next}
-		print STDERR "$0:", " " x $level, " removing $dir/$i failed: $!\n";
-	    }
-	    
-	} 
-	$notremoved++;
-    }
-    if ($verbose > 1) {
-	print STDERR "$0:", " " x $level, " cleandir: $notremoved }\n";
-    }
-    return $notremoved;
-}
-
-sub main {
-    my $since = time() - 14 * 86400;;
-    my $i;
-    while ($i = shift(@ARGV)) {
-	if ($i eq "-d") {
-	    my $days = shift(@ARGV);
-	    $since = time() - $days * 86400;
-	} elsif ($i eq "-v") {
-	    $verbose++;
-	} elsif ($i eq "-n") {
-	    $nop++;
-	} else {
-	    my $cwd = getcwd();
-	    if (chdir($i)) {
-		cleandir($i, $since, 0);
-		chdir($cwd);
-	    }
-	}
-    }
-    exit(0);
-}
-
-main();
-
-# $Log: cleandir,v $
-# Revision 1.4  2000-11-20 21:10:08  hjp
-# Checks introduced in last version prevented deletion of unused subdirs.
-# Fixed.
-#
-# revision 1.3
-# date: 2000/09/10 16:16:41;  author: hjp;  state: Exp;  lines: +37 -6
-# Added checks to detect directory/symlink switching attacks.
-# ----------------------------
-# revision 1.2
-# date: 1999/08/21 12:37:53;  author: hjp;  state: Exp;  lines: +25 -13
-# More levels of verbosity.
-# ----------------------------
-# revision 1.1
-# date: 1999/07/09 21:05:26;  author: hjp;  state: Exp;
-# Added cleandir
-# 

cleandir/cleandir.pl

@@ -1,18 +1,84 @@
 #!@@@perl@@@ -w
+
+=head1 NAME
+
+cleandir - remove unused files from directory
+
+=head1 SYNOPSIS
+
+cleandir [-d days] [-n] [-m] [-v] [-s] [-i|-x regex] directory...
+
+=head1 DESCRIPTION
+
+cleandir recursively searches each directory given on the commandline
+for files and subdirectories which have not been accessed for n days and
+deletes them. It is intended to be used on /tmp and other world-writable
+directories and implements a number of checks to prevent symlink or
+directory switching attacks. It also does not cross mount points.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-d days>
+
+Delete files which have not been accessed for the given number of days.
+The default is 14.
+
+=item B<-m>
+
+Consider only the last modification time of the file, not the last access time.
+
+=item B<-c>
+
+Consider only the inode change time of the file.
+
+=item B<-n>
+
+No-op. Don't delete any files.
+
+=item B<-s>
+
+Skip sockets and named pipes. Some programs (notably X11 and some
+databases) create sockets and named pipes in /tmp and foolishly expect 
+them to survive. This option exists to humour them.
+
+=item B<-v>
+
+Verbose. Can be repeated to increase verbosity.
+
+=item B<-i>|B<-x> regex
+
+Include and exclude patterns. The filenames (not the complete path) of
+all files and directories to be removed are compared against these
+patterns in order. The first hit determines the action. These patterns
+can also be used to override the -s option and to cross mount points.
+
+=back
+
+=head1 AUTHOR
+
+Peter J. Holzer <hjp@hjp.at>. Thanks to Chris Mason for some
+enhancements.
+
+=cut
+
 use strict;
 use File::stat;
 use POSIX;
+use Getopt::Long;
+use Pod::Usage;
+use List::Util qw(max);
 
 my $verbose = 0;
 my $nop = 0;
+my $skip_fifos = 0;
+my $mtime_only = 0;
+my $ctime_only = 0;
 
-sub usage {
-    print STDERR "Usage: $0 [-d days] dir ...\n";
-    exit(1);
-}
 
 sub cleandir {
-    my ($dir, $since, $level) = (@_);
+    my ($dir, $since, $level, $inex) = (@_);
     my $notremoved = 0;
 
     if ($verbose > 1) {
@@ -23,14 +89,43 @@ sub cleandir {
 	return;
     }
     my $std = lstat(".");
+    my $fs = $std->dev;
+
     for my $i (readdir(DIR)) {
 	if ($i eq "." || $i eq "..") {next}
 	if ($verbose > 2) {
 	    print STDERR "$0:", " " x $level, " checking $dir/$i\n";
 	}
 	my $st = lstat("$i");
+        if (!defined($st)) {
+            # file has vanished
+            next;
+        }
+
+	my $action = 'i';
+	# Skip anything on a different filesystem
+	if ($st->dev != $fs) {
+		$action = 'x';
+	}
+
+	# Skip sockets and pipes
+	if ($skip_fifos && (-p _ || -S _)) {
+		$action = 'x';
+	}
+
+	for (@$inex) {
+	    if ($i =~ /$_->[0]/) {
+		$action = $_->[1];
+		last;
+	    }
+	}
+	if ($action eq 'x') {
+		$notremoved++;
+		next;
+	}
+
 	if ($verbose > 3) {
-	    print STDERR "$0:", " " x $level, " mtime=", $st->mtime, " atime=", $st->atime, "\n";
+	    print STDERR "$0:", " " x $level, " mtime=", $st->mtime, " atime=", $st->atime, " ctime=", $st->ctime, "\n";
 	}
 	if (-d _) {
 	    my $cwd = getcwd();
@@ -38,7 +133,7 @@ sub cleandir {
 		my $remaining = -1;
 		my $st1 = lstat(".");
 		if ($st->dev == $st1->dev && $st->ino == $st1->ino) {
-		    $remaining = cleandir("$dir/$i", $since, $level+1);
+		    $remaining = cleandir("$dir/$i", $since, $level+1, $inex);
 		} else {
 		    print STDERR "$0:", " " x $level,
 		    		 " $dir/$i changed dev/inode from ",
@@ -56,29 +151,35 @@ sub cleandir {
 				 " to ",
 				 $std1->dev, "/", $std1->ino,
 				 "\n";
+		    return ++$notremoved;
 		}
-		if ($remaining == 0 && $st->mtime < $since) {
+		my $rtime = $ctime_only ? $st->ctime : $st->mtime;
+		if ($remaining == 0 && $rtime < $since) {
 		    if ($verbose > 0) {
-			print STDERR "$0:", " " x $level, "rmdir $i\n";
+			print STDERR "$0:", " " x $level, "rmdir $dir/$i\n";
 		    }
+		    unless ($nop) {
 			if (rmdir("$i")) {next}
-		    print STDERR "$0:", " " x $level, "rmdir $i failed: $!\n";
+			print STDERR "$0:", " " x $level, "rmdir $dir/$i failed: $!\n";
+		    }
 		} 
 	    } else {
 		print STDERR "$0:", " " x $level, " chdir $dir/$i failed: $!\n";
 	    }
 	    
-	} elsif ($st->mtime < $since && $st->atime < $since) {
-	    if ($nop) {
-		print "would remove $dir/$i\n";
 	} else {
+	    my $rtime = $ctime_only ? $st->ctime :
+	                $mtime_only ? $st->mtime :
+			              max($st->mtime, $st->atime);
+	    if ($rtime < $since) {
 		if ($verbose > 0) {
 		    print STDERR "$0:", " " x $level, " removing $dir/$i\n";
 		}
+		unless ($nop) {
 		    if (unlink("$i")) {next}
 		    print STDERR "$0:", " " x $level, " removing $dir/$i failed: $!\n";
 		}
-	    
+	    } 
 	}
 	$notremoved++;
     }
@@ -90,30 +191,77 @@ sub cleandir {
 
 sub main {
     my $since = time() - 14 * 86400;;
-    my $i;
-    while ($i = shift(@ARGV)) {
-	if ($i eq "-d") {
-	    my $days = shift(@ARGV);
-	    $since = time() - $days * 86400;
-	} elsif ($i eq "-v") {
-	    $verbose++;
-	} elsif ($i eq "-n") {
-	    $nop++;
-	} else {
+    my $help;
+    my @inex;
+
+    GetOptions('help|?' => \$help,
+               'days|d=f' => sub { $since = time() - $_[1] * 86400; },
+               'verbose|v' => sub { $verbose++ },
+	       'nop|n' => \$nop,
+	       'skip-fifos|s' => \$skip_fifos,
+	       'mtime-only|m' => \$mtime_only,
+	       'ctime-only|c' => \$ctime_only,
+	       'include|i=s' => sub { push @inex, [ $_[1], 'i' ] },
+	       'exclude|x=s' => sub { push @inex, [ $_[1], 'x' ] },
+	      ) or pod2usage(2);
+    pod2usage(1) if $help;
+    pod2usage(2) unless (@ARGV);
+    
+
+    while (my $i = shift(@ARGV)) {
 	my $cwd = getcwd();
 	if (chdir($i)) {
-		cleandir($i, $since, 0);
+	    cleandir($i, $since, 0, \@inex);
 	    chdir($cwd);
 	}
     }
-    }
     exit(0);
 }
 
 main();
 
 # $Log: cleandir.pl,v $
-# Revision 1.1  2001-06-25 17:55:03  hjp
+# Revision 1.10  2012-03-02 11:29:42  hjp
+# (Nov 12  2009)
+# Implemented option -c  Consider only the inode change time of the file.
+#
+# Revision 1.9  2006-08-25 09:57:10  hjp
+# Added --include (-i) and --exclude (-x) options.
+#
+# Revision 1.8  2005/04/04 16:05:40  hjp
+# Print whole directory at rmdir with verbose output.
+#
+# Revision 1.7  2004/11/02 09:01:12  hjp
+# Critical bug fix: Empty directories were removed even with -n.
+# Minor cleanup: Message "removing ..." is now the same with and without -n.
+#
+# Revision 1.6  2003/05/16 14:44:58  hjp
+# Added -m option to synopsis.
+#
+# Revision 1.5  2003/05/16 13:38:25  hjp
+# Included -m (mtime-only) option (CVS is nice, but only if it used).
+# Improved pod a bit.
+#
+# Revision 1.4  2003/05/15 10:49:33  hjp
+# Changed tests on skip_fifo to use _ instead of $i. The latter caused
+# extra calls to stat which clobbered the state of _ which caused spurious
+# errors/warnings on symlinks.
+#
+# Revision 1.3  2003/05/14 11:49:56  hjp
+# Added yet another patch by Chris Mason.
+#
+# Added POD.
+#
+# Changed option processing to use Getopt::Long and Pod::Usage.
+#
+# Revision 1.2  2002/02/25 23:33:29  hjp
+# Applied patch from "Chris L. Mason" <cmason@somanetworks.com> to prevent
+# filesystem traversal.
+#
+# Return immediately if we cannot chdir back to the directory we came
+# from.
+#
+# Revision 1.1  2001/06/25 17:55:03  hjp
 # Added configure script to figure out perl location.
 #
 # Revision 1.4  2000/11/20 21:10:08  hjp

cleandir/configure

@@ -18,7 +18,7 @@ do
 done
 if [ -z "$perl" ]
 then
-    could not find a working perl command, sorry.
+    echo could not find a working perl command, sorry.
     exit 1
 fi
 echo "  -e 's,@@@perl@@@,$perl,g' \\" >> customize.$$

collatz/GNUmakefile

@@ -0,0 +1,10 @@
+CFLAGS = -Wall -O9
+all: collatz collatz2 collatz3 modf
+
+collatz:
+
+collatz2: collatz2.o
+	$(CC) -o $@ $^ -lm
+
+clean:
+	rm -f collatz collatz2 collatz3 modf *.o core

collatz/collatz.c

@@ -0,0 +1,40 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+typedef int T;
+#define FT "%d"
+
+int main(void) {
+    T i = 1;
+    long c_max = 0;
+
+    for(;;) {
+	T j = i;
+	long c = 0;
+	while (j != 1) {
+	    if (j % 2 == 1) {
+		T j2 = j * 3 + 1;
+		if ((j2 - 1) / 3 != j) {
+		    printf(FT " is not 3 * " FT " + 1 at starting point " FT, j2, j, i);
+		    exit(1);
+		} 
+		j = j2;
+	    } else {
+		j = j / 2;
+	    }
+	    c++;
+	}
+	if (c > c_max) {
+	    printf("new longest sequence starting at " FT ": %ld steps\n", i, c);
+	    c_max = c;
+	}
+
+	if (i + 1 > i) {
+	    i = i + 1;
+	} else {
+	    printf(FT " is not greater than " FT "\n", i + 1, i);
+	    exit(1);
+	}
+
+    }
+}

collatz/collatz2.c

@@ -0,0 +1,49 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+
+#define USE_DOUBLE 1
+
+#ifdef USE_INT
+    typedef int T;
+    #define FT "%d"
+    #define even(x) ((x) % 2 == 0)
+#elif USE_LONG
+    typedef long T;
+    #define FT "%ld"
+    #define even(x) ((x) % 2 == 0)
+#elif USE_LONG_LONG
+    typedef long long T;
+    #define FT "%lld"
+    #define even(x) ((x) % 2 == 0)
+#elif USE_DOUBLE
+    typedef double T;
+    #define FT "%20.1f"
+    #ifdef USE_FLOOR
+	#define even(x) (floor((x) / 2) == ((x) / 2))
+    #else
+	#define even(x) (fmod((x), 2.0) == 0.0)
+    #endif
+#endif
+
+long collatz(T j) {
+
+    long c = 0;
+    while (j != 1) {
+	printf("%ld: " FT "\n", c, j);
+	if (even(j)) {
+	    j = j / 2;
+	} else {
+	    j = j * 3 + 1;
+	}
+	c++;
+    }
+    return c;
+}
+
+int main(void) {
+    T i = 113383;
+    long c = collatz(i);
+    printf("%ld\n", c);
+    return 0;
+}

collatz/collatz3.c

@@ -0,0 +1,40 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+#define USE_INT 1
+
+#ifdef USE_INT
+    typedef int T;
+    #define FT "%d"
+    #define odd(x) ((x) % 2 == 1)
+#elif USE_LONG
+    typedef long T;
+    #define FT "%ld"
+    #define odd(x) ((x) % 2 == 1)
+#elif USE_DOUBLE
+    typedef double T;
+    #define FT "%20g"
+    #define odd(x) (floor((x) / 2) != ((x) / 2))
+#endif
+
+long collatz(T j) {
+
+    long c = 0;
+    while (j != 1) {
+	printf("%ld: " FT "\n", c, j);
+	if (odd(j)) {
+	    j = j * 3 + 1;
+	} else {
+	    j = j / 2;
+	}
+	c++;
+    }
+    return c;
+}
+
+int main(void) {
+    T i = 113383;
+    long c = collatz(i);
+    printf("%ld\n", c);
+    return 0;
+}

collatz/modf.c

@@ -0,0 +1,15 @@
+#include <stdio.h>
+#include <math.h>
+
+int main(void) {
+    double x = 3.14;
+    double y, z;
+
+    y = modf(x, &z);
+    printf("%g, %g\n", y, z);
+
+    y = modf(x, NULL);
+    printf("%g, %g\n", y, z);
+
+    return 0;
+}

collatz/ulam.txt

@@ -0,0 +1,4 @@
+Ich kannte dieses Problem ursprünglich als "Ulams Vermutung".
+
+Laut http://de.wikipedia.org/wiki/Collatz-Problem stammt es aber
+ursprünglich von Lothar Collatz.

cvstools/GNUmakefile

@@ -0,0 +1,38 @@
+include GNUmakevars
+
+CONFDIR=../../configure
+CONFDIR_exists=$(shell [ -d $(CONFDIR) ] && echo ok)
+
+all: configure find_cvs_not_up_to_date
+
+clean:
+	rm -f find_cvs_not_up_to_date customize
+
+distclean: clean
+
+
+install: $(BINDIR) $(BINDIR)/find_cvs_not_up_to_date
+
+%: %.pl customize
+	sh ./customize < $< > $@
+	chmod +x $@
+
+%: %.sh customize
+	sh ./customize < $< > $@
+	chmod +x $@
+
+customize: configure
+	sh ./configure
+
+ifeq ($(CONFDIR_exists),ok)
+
+configure: $(CONFDIR)/start $(CONFDIR)/perl $(CONFDIR)/finish
+	cat $^ > $@
+
+endif
+
+$(BINDIR):
+	mkdir -p $@
+
+include GNUmakerules
+

cvstools/configure

@@ -0,0 +1,34 @@
+#!/bin/sh
+#
+echo "#!/bin/sh" > customize.$$
+echo "sed \\" > customize.$$
+chmod +x customize.$$
+
+################################################################
+# find a working perl:
+#
+for i in /usr/bin/perl /usr/local/bin/perl /usr/bin/perl5 /usr/local/bin/perl5
+do
+    if $i -e 'exit ($] < 5.000)'
+    then
+	echo $i works
+	perl="$i"
+	break
+    fi
+done
+if [ -z "$perl" ]
+then
+    could not find a working perl command, sorry.
+    exit 1
+fi
+echo "  -e 's,@@@perl@@@,$perl,g' \\" >> customize.$$
+
+
+################################################################
+# finish
+#	Add trailing newline and rename temp file to final name
+#
+echo  >> customize.$$
+
+mv customize.$$ customize
+

cvstools/find_cvs_not_up_to_date.pl

@@ -0,0 +1,28 @@
+#!@@@perl@@@ -w 
+use strict;
+use File::Find;
+use Getopt::Long;
+
+my $debug = 0;
+
+sub check_cvs {
+    local $/ =
+    "===================================================================\n";
+    return unless (-d "$_/CVS");
+    print STDERR "checking $File::Find::dir/$_\n" if ($debug);
+
+    # $_ is a CVS working dir
+
+    open (CVSSTATUS, "cd $_ && cvs -q status|");
+    while(<CVSSTATUS>) {
+	print if  (/Status/ && !/Status: Up-to-date/);
+    }
+    close(CVSSTATUS);
+
+    # don't recurse, cvs already did:
+    $File::Find::prune = 1;
+}
+
+GetOptions("debug" => \$debug);
+@ARGV = (".") unless (@ARGV);
+find(\&check_cvs, @ARGV);

dbi/dumpsql

@@ -0,0 +1,177 @@
+#!/usr/bin/perl 
+
+=head1 NAME
+
+dumpsql - dump output of an SQL query
+
+=head1 SYNOPSIS
+
+dumpsql
+[ --vertical
+[ --escape ]
+|
+--xhtml
+[ --style uri ]
+]
+query
+
+=head1 DESCRIPTION
+
+Connects to the database identified by the environment variable
+DBI_CREDENTIAL_FILE, executes the query given on the command line and
+prints the output to stdout.
+
+By default the output is tab-separated. Two alternate formats are
+available: 
+
+--vertical prints each field in a separate line in "Columnname: Value"
+format. Rows are separated by empty lines. --Escape escapes unprintable
+characters.
+
+--xhtml prints the table as an XHTML file. Optionally a style sheet can
+be specified with --style.
+
+=head1 BUGS
+
+The --escape option only works with --vertical. It should also work with
+the other two styles.
+
+=cut
+
+use warnings;
+use strict;
+use DBI;
+use Getopt::Long;
+use Encode qw(:fallbacks encode);
+use I18N::Langinfo qw(langinfo CODESET);
+use Pod::Usage;
+
+my $charset = langinfo(CODESET);
+binmode STDOUT, "encoding($charset)";
+
+
+my $help;
+my $vertical;	# use vertical output format
+my $escape;	# escape non-printable characters
+my $xhtml;	# produce XHTML output
+my $style;	# produce XHTML output
+
+GetOptions(
+    'help|?'	=> \$help, 
+    'vertical'	=> \$vertical, 
+    'xhtml'	=> \$xhtml, 
+    'escape'	=> \$escape, 
+    'style:s'	=> \$style, 
+) || pod2usage(2);
+pod2usage(1) if $help;
+
+
+# read credits from file
+sub _read_cred {
+    my ($fn) = @_;
+
+    open(FN, "<$fn") or die "cannot open $fn: $!";
+    my $line = <FN>; 
+    close(FN);
+    my @cred = split(/\s+/, $line); 
+    return @cred;
+}
+
+
+my $dbh;
+
+sub dbiconnect {
+    my $cred_file = $ENV{DBI_CREDENTIAL_FILE};
+    if (! defined($cred_file)) {
+        $cred_file = "$ENV{HOME}/.dbi/default";
+    } elsif ($cred_file !~ m{/}) { 
+        $cred_file = "$ENV{HOME}/.dbi/$cred_file";
+    }
+
+    $dbh = DBI->connect(_read_cred($cred_file), {RaiseError => 1, AutoCommit => 0}); 
+
+    my $driver = $dbh->{Driver}->{Name};
+    if ($driver eq 'Pg') {
+        $dbh->{pg_enable_utf8} = 1;
+    }
+    return $dbh;
+}
+
+$dbh = dbiconnect();
+$dbh->{LongReadLen} = 0x1_0000;
+
+my $query = shift(@ARGV);
+my @args = @ARGV;
+my $sth = $dbh->prepare($query);
+$sth->execute(@args);
+if ($xhtml) {
+    print qq{<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">\n};
+    print qq{<html>\n};
+    print qq{<head>\n};
+    print qq{<title>}, xmlencode($query), qq{</title>\n};
+    if ($style) {
+	print qq{<link rel='stylesheet' type='text/css' href='},
+	      xmlencode($style),
+	      qq{'/>\n};
+    }
+    print qq{</head>\n};
+    print qq{<head>\n};
+    print qq{<body>\n};
+    print qq{<h1>}, xmlencode($query), qq{</h1>\n};
+    if (@args) {
+	print qq{<ul>\n};
+	for (@args) {
+	    print qq{<li>}, xmlencode($_), qq{</li>\n};
+	}
+	print qq{</ul>\n};
+    }
+    print qq{<table>\n};
+    print qq{<tr>},
+	  (
+	      map {
+		"<th>" . xmlencode($_) . "</th>"
+	      } @{$sth->{NAME}}
+	  ),
+	  "</tr>\n";
+    while (my @a = $sth->fetchrow_array()) {
+	print qq{<tr>},
+	      (
+		  map {
+		    "<td>"
+		    . (defined($_) ? xmlencode($_) : '<em>NULL</em>')
+		    . "</td>"
+		  } @a
+	      ),
+	      "</tr>\n";
+    }
+    print qq{</table>\n};
+    print qq{</body>\n};
+    print qq{</html>\n};
+} elsif ($vertical) {
+    while (my @a = $sth->fetchrow_array()) {
+	for my $i (0 .. $#a) {
+	    print $sth->{NAME}[$i], ": ";
+	    if ($escape) {
+		if (defined($a[$i])) {
+		    print encode("us-ascii", $a[$i], FB_PERLQQ), "\n";
+		} else {
+		    print "NULL\n";
+		}
+	    } else {
+		print $a[$i] // "NULL", "\n";
+	    }
+	}
+	print "\n";
+    }
+} else {
+    no warnings 'uninitialized';
+    print join("\t", @{$sth->{NAME}}), "\n";
+    while (my @a = $sth->fetchrow_array()) {
+	print join("\t", @a), "\n";
+    }
+}
+
+sub xmlencode {
+    my ($s) = @_;
+    return encode("us-ascii", $s, FB_XMLCREF);
+}

ddm/GNUmakefile

@@ -1,4 +1,4 @@
-# $Id: GNUmakefile,v 1.3 2000-06-04 16:33:20 hjp Exp $
+# $Id: GNUmakefile,v 1.4 2002-03-18 20:49:54 hjp Exp $
 
 include GNUmakevars
 
@@ -8,7 +8,10 @@ ddm: ddm.o
 ddm.o: ddm.c
 
 clean:
-	rm ddm ddm.o
+	rm -f ddm ddm.o
+
+distclean: clean
+	rm -f cfg/mnttab.h
 
 install: $(SBINDIR)/ddm
 
@@ -20,7 +23,10 @@ include GNUmakerules
 -include ddm.d
 
 # $Log: GNUmakefile,v $
-# Revision 1.3  2000-06-04 16:33:20  hjp
+# Revision 1.4  2002-03-18 20:49:54  hjp
+# Added target distclean
+#
+# Revision 1.3  2000/06/04 16:33:20  hjp
 # Removed MNTTAB autodetection again as it seems to be already defined.
 # Don't skip rest of mountpoints if one is not accessible.
 # chdir to / while sleeping to avoid blocking automounters

dns/GNUmakefile

@@ -1,20 +1,42 @@
 include GNUmakevars
-include GNUmakerules
 
-all: gethostbyname
-install: $(BINDIR)/gethostbyname
+all: gethostbyaddr gethostbyname fqdn query check
+install: \
+	$(BINDIR)/axfr \
+	$(BINDIR)/fqdn \
+	$(BINDIR)/gethostbyaddr \
+	$(BINDIR)/gethostbyname \
+	$(BINDIR)/minnet \
+	$(BINDIR)/query \
+	$(BINDIR)/dns-inc-serial \
+
 
 clean:
-	rm -f *.bak *.o core gethostbyname
+	rm -f *.bak *.o core gethostbyaddr gethostbyname fqdn check
 
 distclean: clean
-	rm -f *.d
+	rm -f *.d GNUmakevars GNUmakerules
 
 cfg/%:
 	$(MAKE) -C cfg all
 
 gethostbyname: gethostbyname.o hstrerror.o
 
+fqdn: fqdn.o hstrerror.o
+
 hstrerror.o: cfg/have_hstrerror.h
 
+axfr:
+
+%: %.pl
+	cp $< $@
+	chmod +x $@
+
+GNUmakevars: GNUmakevars.sh
+	sh ./$^ > $@
+GNUmakerules: GNUmakerules.sh
+	sh ./$^ > $@
+
+include GNUmakerules
+
 -include *.d

dns/GNUmakerules.sh

@@ -0,0 +1,3 @@
+#!/bin/sh
+echo "\$(BINDIR)/%: %"
+echo "\tcp \$^ \$@"

dns/GNUmakevars.sh

@@ -0,0 +1,5 @@
+#!/bin/sh
+prefix=${prefix:-/usr/local}
+echo "BINDIR=$prefix/bin"
+echo
+echo "all:"

dns/axfr.pl

@@ -0,0 +1,21 @@
+#!/usr/bin/perl -w
+use strict;
+use Net::DNS;
+
+sub usage {
+    print STDERR "Usage: $0 zone nameserver\n" unless (@ARGV == 2);
+    exit(1);
+}
+
+usage() unless (@ARGV == 2);
+
+my $res = new Net::DNS::Resolver;
+$res->nameservers($ARGV[1]);
+my @zone = $res->axfr($ARGV[0]);
+if (@zone) {
+    foreach my $rr (@zone) {
+	$rr->print;
+    }
+} else {
+    print STDERR "query failed: ", $res->errorstring, "\n";
+}

dns/cfg/GNUmakefile

@@ -2,3 +2,6 @@ all: have_hstrerror.h
 
 %.h: %.sh
 	CC='$(CC)' CFLAGS='$(CFLAGS)' LDFLAGS='$(LDFLAGS)' sh $^ > $@
+
+clean:
+	rm *.h

dns/check-ptr

@@ -0,0 +1,68 @@
+#!/usr/bin/perl -w
+use strict;
+use Net::DNS;
+
+sub usage {
+    print STDERR "Usage: $0 ip-address\n";
+    exit(1);
+}
+
+usage() unless (@ARGV == 1);
+
+# generic resolver
+my $res0 = new Net::DNS::Resolver;
+
+my $ipv4 = $ARGV[0];
+
+my $rev_domain = join(".", reverse (split(/\./, $ipv4)), "in-addr", "arpa");
+print STDERR "$rev_domain\n";
+
+my $reply = $res0->send($rev_domain, 'PTR');
+
+if ($reply->answer) {
+    for my $rr ($reply->answer) {
+        if ($rr->type eq 'PTR') {
+            print STDERR "\t", $rr->ptrdname, "\n";
+            check_a($rr->ptrdname, $ipv4);
+        }
+    }
+} elsif ($reply->authority) {
+    for my $rr ($reply->authority) {
+        if ($rr->type eq 'SOA') {
+            print STDERR "\t", $rr->mname, "\n";
+            my $res1 = Net::DNS::Resolver->new();
+            $res1->nameservers($rr->mname);
+            my @zone = $res1->axfr($rev_domain);
+            for my $rr (@zone) {
+                if ($rr->type eq 'PTR') {
+                    print STDERR "\t\t", $rr->ptrdname, "\n";
+                    my $ipv4 = join(".", (reverse(split(/\./, $rr->name)))[2..5]);
+                    check_a($rr->ptrdname, $ipv4);
+                }
+            }
+        }
+    }
+} else {
+    $reply->print
+}
+
+sub check_a {
+    my ($domain_name, $a) = @_;
+    # check that $domain_name resolves to $a
+
+    my $reply = $res0->send($domain_name, 'A');
+
+    if ($reply->answer) {
+        for my $rr ($reply->answer) {
+            if ($rr->type eq 'A') {
+                print STDERR "\t\t", $rr->address, "\n";
+                if ($rr->address eq $a) {
+                    print STDERR "\t\t\tfound\n";
+                    return 1;
+                }
+            }
+        }
+    }
+    print " $a $domain_name FWD_FAIL\n";
+    return 0;
+}

dns/check.pl

@@ -0,0 +1,317 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use Net::DNS;
+
+sub usage {
+    print STDERR "Usage: $0 domainname-or-ip-address\n";
+    exit(1);
+}
+
+my $verbose;
+
+if (($ARGV[0] || '') eq '-v') {
+    $verbose = 1;
+    shift @ARGV;
+}
+
+usage() unless (@ARGV == 1);
+
+# generic resolver
+my $res0 = new Net::DNS::Resolver;
+
+# special resolver to query specific nameservers
+my $res1 = new Net::DNS::Resolver;
+my $zone;
+if ($ARGV[0] =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
+    check_ptr($ARGV[0]);
+} else {
+    check_a($ARGV[0]);
+}
+check_zone($ARGV[0]) if ($zone);
+
+exit 0;
+
+my %addr_to_name;
+my %name_to_addr;
+
+sub check_ptr {
+    my ($addr, $name) = @_;
+
+    my @names;
+    if (defined $addr_to_name{$addr}) {
+        @names = @{ $addr_to_name{$addr} };
+    } else {
+        # XXX - ipv6?
+        my $q = join('.', reverse (split(/\./, $addr)), "in-addr", "arpa");
+        my $reply = $res0->send($q, 'PTR');
+        for my $ans ($reply->answer) {
+            if ($ans->type eq 'PTR') {
+                push @names, $ans->ptrdname;
+            } else {
+                die "cannot happen";
+            }
+        }
+        if (@names == 0) {
+            print "[$addr] $q has no PTR record\n";
+        }
+        $addr_to_name{$addr} = \@names;
+	get_zone($reply) unless $zone;
+    }
+    if ($name) {
+        unless (grep { $_ eq $name } @names) {
+            print "$name not found in PTR records of [$addr]\n";
+        }
+        return;
+    }
+    for my $name (@names) {
+	print "I: [$addr] -> $name\n" if $verbose;
+        check_a($name, $addr);
+    }
+}
+
+sub check_a {
+    my ($name, $addr) = @_;
+
+    my @addrs;
+    if (defined $name_to_addr{$name}) {
+        @addrs = @{ $name_to_addr{$name} };
+    } else {
+        my $reply = $res0->send($name, 'A');
+        for my $ans ($reply->answer) {
+            if ($ans->type eq 'A') {
+                push @addrs, $ans->address;
+	    } elsif ($ans->type eq 'CNAME') {
+		die "cnames not yet supported";
+            } else {
+                print "unexpected response to A query for $name\n";
+		$ans->print;
+            }
+        }
+         if (@addrs == 0) {
+            print "$name has no A record\n";
+        }
+        $name_to_addr{$name} = \@addrs;
+	get_zone($reply) unless $zone;
+    }
+    if ($addr) {
+        unless (grep { $_ eq $addr } @addrs) {
+            print "[$addr] not found in A records of $name\n";
+        }
+        return;
+    }
+    for my $addr (@addrs) {
+	print "I: $name -> [$addr]\n" if $verbose;
+        check_ptr($addr, $name);
+    }
+}
+
+sub get_zone {
+    my ($reply) = @_;
+
+    for my $auth ($reply->authority) {
+	if (defined $zone) {
+	    if ($zone ne $auth->name) {
+		print "inconsistent authority RRs:\n";
+		print $auth->print;
+		print "doesn't match previously found zone $zone\n";
+	    }
+	} else {
+	    $zone = $auth->name;
+	}
+    }
+}
+
+sub check_zone {
+    my ($name) = @_;
+
+    my $rootns = chr(rand(13) + 65) . ".root-servers.net.";
+    my $reply = $res0->send($rootns, 'A');
+    my @ns = (($reply->answer)[0]->address);
+    my %authns;
+    my %seen;
+    while (@ns) {
+	my $ns = shift (@ns);
+	$res1->nameservers($ns);
+	my $reply = $res1->send($zone, 'NS');
+
+	# if the reply contains a non-empty answer section, use it as
+	# a list of authoritative name servers.
+	if ($reply->answer) {
+	    for my $rr ($reply->answer) {
+		if ($rr->type eq 'NS') {
+		    print STDERR "$ns reported NS ", $rr->nsdname, "\n";;
+
+		    $authns{$ns}{$rr->nsdname} = 1;
+		    $authns{ALL}{$rr->nsdname} = 1;
+		    for (get_addresses($rr->nsdname)) {
+			unless ($seen{$_}) {
+			    push @ns, $_;
+			    $seen{$_} = 1;
+			}
+		    }
+		}
+	    }
+	    next;
+	}
+	#
+	if ($reply->authority) {
+	    for my $rr ($reply->authority) {
+		if ($rr->type eq 'NS') {
+		    if ($rr->name eq $name) {
+			# if the reply contains an authority section with the right
+			# domain, use it as a list of authoritative name servers.
+			print STDERR "$ns reported NS ", $rr->nsdname, "\n";;
+
+			$authns{$ns}{$rr->nsdname} = 1;
+			$authns{ALL}{$rr->nsdname} = 1;
+			for (get_addresses($rr->nsdname)) {
+			    unless ($seen{$_}) {
+				push @ns, $_;
+				$seen{$_} = 1;
+			    }
+			}
+		    } else {
+			# Otherwise, just add the nameservers from the authority section
+			# to the list of nameservers still to query.
+			for (get_addresses($rr->nsdname)) {
+			    unless ($seen{$_}) {
+				push @ns, $_;
+				$seen{$_} = 1;
+			    }
+			}
+		    }
+		}
+	    }
+	    next;
+	}
+
+	
+    }
+
+    # We must make sure that we get a result from all authoritative
+    # name servers
+    #
+    # XXX
+    #
+    # Isn't that included in the next test? If an authoritative
+    # nameserver doesn't answer, it will be reported as not reporting 
+    # all nameservers.
+
+    # All lists of nameservers must be identical.
+    #
+    for my $authns (sort keys %{ $authns{ALL} }) {
+	for my $origns (sort keys %authns) {
+	    print "$origns doesn't report $authns\n" unless $authns{$origns}{$authns};
+	}
+    }
+
+    my @noaxfr;
+    my %zone;
+    for my $authns (sort keys %{ $authns{ALL} }) {
+	$res1->nameservers($authns);
+	my @zone = $res1->axfr($zone);
+	push @noaxfr, $authns unless @zone;
+	for my $rr (@zone) {
+	    my $key = rr2key($rr);
+
+	    $zone{$authns}{$rr->name}{$rr->type}{$key} = 1;
+	    $zone{ALL}{$rr->name}{$rr->type}{$key} = 1;
+	}
+    }
+    for my $authns (@noaxfr) {
+	$res1->nameservers($authns);
+	for my $name (sort keys %{ $zone{ALL} }) {
+	    for my $type (sort keys %{ $zone{ALL}{$name} }) {
+		my $reply = $res1->send($name, $type);
+		for my $rr ($reply->answer) {
+		    if ($rr->type eq $type) {
+			my $key = rr2key($rr);
+			$zone{$authns}{$rr->name}{$rr->type}{$key} = 1;
+			$zone{ALL}{$rr->name}{$rr->type}{$key} = 1;
+		    }
+		}
+	    }
+	}
+    }
+    for my $authns (sort keys %zone) {
+	# next if $authns eq 'ALL';
+	for my $name (sort keys %{ $zone{ALL} }) {
+	    for my $type (sort keys %{ $zone{ALL}{$name} }) {
+		for my $key (sort keys %{ $zone{ALL}{$name}{$type} }) {
+		    unless ($zone{$authns}{$name}{$type}{$key}) {
+			print STDERR "$authns is missing $name $type $key\n";
+		    }
+		}
+	    }
+	}
+    }
+
+
+}
+
+sub get_addresses {
+    my ($name) = @_;
+    my @addrs;
+    my $reply = $res0->send($name, 'A');
+    for my $rr ($reply->answer) {
+	if ($rr->type eq 'A') {
+	    push @addrs, $rr->address;
+	}
+	# XXX - resolve CNAMEs?
+    }
+    return @addrs;
+}
+
+sub rr2key {
+    my ($rr) = @_;
+
+    my $key;
+
+    if ($rr->type eq 'A') {
+	$key = $rr->address;
+    } elsif ($rr->type eq 'SOA') {
+	$key = join(' ', $rr->mname, $rr->rname, $rr->serial, $rr->refresh, $rr->retry, $rr->expire, $rr->minimum);
+    } elsif ($rr->type eq 'NS') {
+	$key = $rr->nsdname;
+    } elsif ($rr->type eq 'MX') {
+	$key = join(' ', $rr->preference, $rr->exchange);
+    } elsif ($rr->type eq 'CNAME') {
+	$key = $rr->cname;
+    } elsif ($rr->type eq 'TXT') {
+	$key = $rr->txtdata;
+    } elsif ($rr->type eq 'SRV') {
+	$key = join(' ', $rr->priority, $rr->weight, $rr->port, $rr->target);
+    } elsif ($rr->type eq 'PTR') {
+	$key = $rr->ptrdname;
+    } elsif ($rr->type eq 'HINFO') {
+	$key = join(' ', $rr->cpu, $rr->os);
+    } elsif ($rr->type eq 'LOC') {
+	# sloppy
+	my ($lat, $lon) = $rr->latlon;
+	$key = join(' ', $lat, $lon, $rr->altitude);
+    } else {
+	print STDERR "unhandled RR:\n";
+	print STDERR $rr->string, "\n";
+	exit(1);
+    }
+    return $key;
+}
+
+# Notes:
+# 
+# for every a record, check ptr.
+#
+# for every ptr, check a
+#
+# find the zone (authority section).
+#
+# Check name servers (starting at random root).
+#
+# Try axfr.
+# check each record:
+#  the same on all nameservers?
+#  A to PTR and vice versa
+#  MX 
+#
+# vim: tw=0 sw=4 expandtab

dns/dns-inc-serial

@@ -0,0 +1,70 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use Getopt::Long;
+use Net::DNS::Resolver;
+
+my $cfg;
+GetOptions('config:s' => \$cfg);
+
+my %file2zone;
+my $res;
+
+if ($cfg) {
+    # XXX - this is very simplistic
+    open(my $fh, '<', $cfg) or die "cannot open $cfg: $!";
+    my $currentzone;
+    while (<$fh>) {
+	if (/zone "(.*?)"/) {
+	    $currentzone = $1;
+	} elsif (m{file ".*/(.*)"}) {
+	    $file2zone{$1} = $currentzone;
+	}
+    }
+    $res = Net::DNS::Resolver->new();
+}
+
+for my $f (@ARGV) {
+    my $maxserial = 0;
+    if (my $zone = $file2zone{$f}) {
+	my $reply = $res->send($zone, 'NS');
+	my @nsnames;
+	for my $ans ($reply->answer) {
+	    push @nsnames, $ans->nsdname;
+	}
+	my @nsips;
+	for (@nsnames) {
+	    my $reply = $res->send($_, 'A');
+	    for my $ans ($reply->answer) {
+		push @nsips, $ans->address if $ans->type eq 'A';
+	    }
+	}
+	for (@nsips) {
+	    $res->nameservers($_);
+	    my $reply = $res->send($zone, 'SOA');
+	    for my $ans ($reply->answer) {
+		if ($ans->type eq 'SOA') {
+		    # XXX assume no wraparound
+		    if ($ans->serial > $maxserial) {
+			$maxserial = $ans->serial;
+		    }
+		}
+	    }
+	}
+    }
+    open (my $in, '<', "$f") or die "cannot open $f: $!";
+    open (my $out, '>', "$f.new") or die "cannot open $f.new: $!";
+    while (<$in>) {
+	if (/(.*\bSOA\b.*?)(\d+)( \d+ \d+ \d+ \d+)/) {
+	    my $serial = $2;
+	    $maxserial = $serial if ($serial > $maxserial);
+	    $maxserial++;
+	    print $out "$1$maxserial$3\n";
+	} else {
+	    print $out $_;
+	}
+    }
+    close($out) or die "cannot close $f.new: $!";
+    rename "$f.new", $f || die "cannot rename $f.new to $f: $!";
+}

dns/fix_negative_ttl

@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use autodie;
+
+for my $zonefile (@ARGV) {
+    open my $in, '<', $zonefile;
+    open my $out, '>', "$zonefile.$$";
+    while (<$in>) {
+        # @               SOA     ns1.wsr.ac.at. hostmaster.wsr.ac.at. 1957 14400 3600 604800 86400
+        if ( my ($prefix, $master, $rp, $serial, $refresh, $retry, $expire, $negttl)
+                = m/(.*)SOA\s+(\S+)\s+(\S+)\s(\d+)\s(\d+)\s(\d+)\s(\d+)\s(\d+)/
+        ) {
+            # maximum time recommended by RFC 2308, also enforced by
+            # BIND (by default).
+            if ($negttl >= 3 * 3600) {
+                $negttl = 3600;
+                $serial++;
+            }
+            print $out "${prefix}SOA\t$master $rp $serial $refresh $retry $expire $negttl\n";
+        } else {
+            print $out $_;
+        }
+    }
+    rename "$zonefile.$$", $zonefile;
+}
+

dns/fqdn.c

@@ -0,0 +1,80 @@
+/*
+ * fqdn - print fully qualified domain name(s)
+ *
+ * resolve all host names given on the comman line and print their
+ * fully qualified canonical names.
+ *
+ * If no argument is given, print the system's FQDN.
+ */
+
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include <unistd.h>
+#include <netdb.h>
+
+#include "hstrerror.h"
+
+char cvs_id[] = "$Id: fqdn.c,v 1.5 2004-05-17 18:13:46 hjp Exp $";
+
+char *cmnd;
+
+void usage(void) {
+    fprintf(stderr, "Usage: %s [hostname ...]\n", cmnd);
+    exit(1);
+}
+
+int main(int argc, char **argv) {
+    int i;
+    int rc = 0;
+    char hostname[256];
+    char *fake_argv[] = { NULL, hostname, NULL };
+
+    cmnd = argv[0];
+
+    if (argc < 2) {
+	if (gethostname(hostname, sizeof(hostname)) == -1) {
+	    fprintf(stderr, "%s: cannot get hostname: %s\n",
+		    cmnd, strerror(errno));
+	    exit(1);
+	}
+	argv = fake_argv;
+	argc = 2;
+    }
+
+    for (i = 1; i < argc; i++) {
+	struct hostent *he = gethostbyname(argv[i]);
+	int found = 0;
+
+	if (!he) {
+	    fprintf(stderr, "%s: cannot resolve %s: %s\n",
+	    	    cmnd, argv[i], hstrerror(h_errno));
+	    rc++;
+	    continue;
+	}
+
+	if (strchr(he->h_name, '.')) {
+	    printf("%s\n", he->h_name);
+	    found = 1;
+	} else {
+	    char **a;
+	    fprintf(stderr, "Canonical name doesn't contain a dot.\n");
+	    fprintf(stderr, "Please shoot the administrator of this box.\n");
+	    fprintf(stderr, "In the mean time I try to find a suitable alias.\n");
+	    for (a = he->h_aliases; !found && *a; a++) {
+		if (strchr(*a, '.')) {
+		    printf("%s\n", *a);
+		    found = 1;
+		}
+	    }
+	    if (!found) {
+		fprintf(stderr, "No alias, either. Consider more painful methods than shooting.\n");
+		rc++;
+	    }
+	}
+
+    }
+    return rc;
+}

dns/gethostbyaddr.c

@@ -0,0 +1,57 @@
+#include <netdb.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "hstrerror.h"
+
+char *cmnd;
+
+void usage(void) {
+    fprintf(stderr, "Usage: %s [hostname ...]\n", cmnd);
+    exit(1);
+}
+
+int main(int argc, char **argv) {
+    int i;
+    int rc = 0;
+
+    cmnd = argv[0];
+
+    if (argc < 2) {
+	usage();
+    }
+
+    for (i = 1; i < argc; i++) {
+        struct in_addr ia;
+        if (!inet_aton(argv[i], &ia)) {
+            fprintf(stderr, "%s: cannot parse %s\n",
+                    argv[0], argv[i]);
+            continue;
+        }
+	struct hostent *he = gethostbyaddr(&ia, sizeof(ia), AF_INET);
+	char **a;
+
+	if (!he) {
+	    fprintf(stderr, "%s: cannot resolve %s: %s\n",
+	    	    argv[0], argv[i], hstrerror(h_errno));
+	    rc++;
+	    continue;
+	}
+
+	printf("%s\n", argv[i]);
+	printf("\tCanonical:  %s\n", he->h_name);
+	for (a = he->h_aliases; *a; a++) {
+	    printf("\tAlias:      %s\n", *a);
+	}
+	for (a = he->h_addr_list; *a; a++) {
+	    int j;
+	    printf("\tAddress:    ");
+	    for (j = 0; j < he->h_length; j++) {
+		printf("%s%d", j ? "." : "", (unsigned char)(*a)[j]);
+	    }
+	    printf("\n");
+	}
+	printf("\n");
+    }
+    return rc;
+}

dns/minnet

@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+my $min = 0xFFFF_FFFF;
+my $max = 0x0000_0000;
+
+for (@ARGV) {
+    if (/(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
+	my $adr = $1 * 0x100_0000 + $2 * 0x1_0000 + $3 * 0x100 + $4;
+	$max = $adr if ($adr > $max);
+	$min = $adr if ($adr < $min);
+    }
+}
+
+my $diff = $min ^ $max;
+
+# printf "min = %08x max = %08x diff = %08x\n", $min, $max, $diff;
+
+my $netmaskbits = 32;
+my $netmask = 0xFFFF_FFFF;
+
+while ($diff > 0) {
+    $netmaskbits--;
+    $diff >>= 1;
+    $netmask <<= 1;
+}
+
+my $net = $min & $netmask;
+my $bcast = $min | ~$netmask;
+
+printf "net = %s/%d (%s/%s) bcast = %s\n",
+       dottedquad($net),
+       $netmaskbits,
+       dottedquad($net),
+       dottedquad($netmask),
+       dottedquad($bcast);
+
+sub dottedquad {
+    my ($adr) = @_;
+    return sprintf "%d.%d.%d.%d",
+		   ($adr >> 24) & 0xFF,
+		   ($adr >> 16) & 0xFF,
+		   ($adr >>  8) & 0xFF,
+		   ($adr >>  0) & 0xFF;
+}
+
+exit(0);

dns/query

@@ -0,0 +1,19 @@
+#!/usr/bin/perl -w
+use strict;
+use Net::DNS;
+
+sub usage {
+    print STDERR "Usage: $0 domainname type nameserver\n" unless (@ARGV == 2);
+    exit(1);
+}
+
+usage() unless (@ARGV == 3);
+
+my $res = new Net::DNS::Resolver;
+$res->nameservers($ARGV[2]);
+my $answer = $res->query($ARGV[0], $ARGV[1]);
+if ($answer) {
+    $answer->print;
+} else {
+    print STDERR "query failed: ", $res->errorstring, "\n";
+}

dup/removeduplicatemails

@@ -0,0 +1,52 @@
+#!/usr/bin/perl 
+use warnings;
+use strict;
+
+use File::Find;
+
+use MIME::Parser;
+my $parser = new MIME::Parser;
+$parser->output_to_core(1);
+$parser->tmp_to_core(1);
+
+my %files;
+my %messages;
+sub check_file {
+    unless (-f) {
+	return;
+    }
+    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+        $atime,$mtime,$ctime,$blksize,$blocks) = stat(_);
+    if ($files{"$dev.$ino"}) {
+	# we already looked at this file - skip
+	return;
+    }
+    my $entity = $parser->parse_open($_);
+    unless ($entity) {
+	print STDERR "$File::Find::name cannot be parsed: skipping\n";
+	return;
+    }
+    my $mid =  $entity->head->get('Message-Id');
+    unless ($mid) {
+	print STDERR "$File::Find::name contains no message id: skipping\n";
+	return;
+    }
+    if ($messages{$mid}) {
+	# duplicate!
+	print STDERR "$File::Find::name is a duplicate of ",
+		     $files{$messages{$mid}},
+		     "\n";
+	my $ft = $File::Find::name;
+	$ft =~ s|(.*/)(.*)|$1|;
+	$ft .= "removedups.$$." . rand;
+	link ($files{$messages{$mid}}, $ft) && rename ($ft, $File::Find::name) || do {
+	    print STDERR "\terror: $!\n";
+	};
+	return;
+    } 
+    $messages{$mid} = "$dev.$ino";
+    $files{"$dev.$ino"} = $File::Find::name;
+}
+
+find(\&check_file, @ARGV);
+

dup/removedups

@@ -0,0 +1,57 @@
+#!/usr/bin/perl 
+use warnings;
+use strict;
+
+use File::Find;
+use Digest::SHA1;
+use Data::Dumper;
+
+my %files;
+sub check_file {
+    unless (-f) {
+	return;
+    }
+    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+        $atime,$mtime,$ctime,$blksize,$blocks) = stat(_);
+    $files{$size}{i}{"$dev.$ino"}{n}{$File::Find::name} = 1;
+}
+
+print STDERR "sorting files by size\n";
+find(\&check_file, @ARGV);
+print STDERR "... done\n";
+
+for my $s (sort { $a <=> $b } keys %files) {
+    print STDERR "checking files of size $s\n";
+    if (scalar keys %{$files{$s}{i}} == 1) {
+	print STDERR "only one file of size $s: skipping\n";
+    } else {
+	for my $i (keys %{$files{$s}{i}}) {
+	    my $f = (keys %{$files{$s}{i}{$i}{n}})[0];
+	    if (open (F, "<", $f)) {
+		# print STDERR "\tcomputing checksum of $f\n";
+		my $sha1 = Digest::SHA1->new;
+		$sha1->addfile(*F);
+		my $d = $sha1->b64digest;
+		if ($files{$s}{d}{$d}) {
+		    print STDERR "\t\tduplicate found\n";
+		    my $fo = (keys %{$files{$s}{d}{$d}{n}})[0];
+		    for my $fd (keys %{$files{$s}{i}{$i}{n}}) {
+			print "\t\t\tlinking $fd to $fo\n";
+			my $ft = $fd;
+			$ft =~ s|(.*/)(.*)|$1|;
+			$ft .= "removedups.$$." . rand;
+			link ($fo, $ft) && rename ($ft, $fd) || do {
+			    print STDERR "\t\t\t\terror: $!\n";
+			}
+		    }
+		} else {
+		    $files{$s}{d}{$d} = $files{$s}{i}{$i};
+		}
+	    } else {
+		print STDERR "cannot open $f: $!: ignoring\n";
+	    }
+	    delete $files{$s}{i}{$i};
+	}
+	# print Dumper $files{$s};
+    }
+}

errno/GNUmakefile

@@ -1,15 +1,48 @@
-# $Id: GNUmakefile,v 1.2 1998-05-31 01:20:06 hjp Exp $
+# $Id: GNUmakefile,v 1.8 2016-07-05 19:52:03 hjp Exp $
 # $Log: GNUmakefile,v $
-# Revision 1.2  1998-05-31 01:20:06  hjp
+# Revision 1.8  2016-07-05 19:52:03  hjp
+# Add target distclean
+#
+# Revision 1.7  2011-01-30 19:41:15  hjp
+# Replaced GNUmakerules.sh with GNUmakerules.pl because Debian now uses a
+# /bin/sh which doesn't understand echo -e.
+#
+# Revision 1.6  2011-01-30 19:33:28  hjp
+# removed duplicate rules
+#
+# Revision 1.5  2011-01-30 19:32:33  hjp
+# create GNUmakerules and GNUmakevars
+#
+# Revision 1.4  2008-04-05 10:04:53  hjp
+# added GNUmake*.sh
+#
+# Revision 1.3  2003/02/14 11:59:43  hjp
+# Added list of #defines from HP-UX.
+#
+# Revision 1.2  1998/05/31 01:20:06  hjp
 # GNUmakerules split into GNUmakerules and GNUmakevars.
 #
 
 include GNUmakevars
-include GNUmakerules
 
 all: errno
 
-errno:
+errno: errno.o errno_list.o
+errno_list.c: errno.list make_errno_list
+	./make_errno_list
+
 clean:
 	rm errno
+
+distclean: clean
+	rm -f GNUmakevars GNUmakerules errno_list.c
+
 install: $(BINDIR)/errno
+
+GNUmakevars: GNUmakevars.sh
+	sh ./$^ > $@
+GNUmakerules: GNUmakerules.pl
+	perl ./$^ > $@
+
+include GNUmakerules
+-include *.d

errno/GNUmakerules.pl

@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+print "\$(BINDIR)/%: %\n";
+print "\tcp \$^ \$@\n";
+print "\$(MAN1DIR)/%: %\n";
+print "\tcp \$^ \$@\n";

errno/GNUmakevars.sh

@@ -0,0 +1,15 @@
+#!/bin/sh
+prefix=${prefix:-/usr/local}
+echo "BINDIR=$prefix/bin"
+
+for i in "$prefix/share/man/man1" "$prefix/man/man1"
+do
+	if [ -d "$i" -a -w "$i" ]
+	then
+		echo "MAN1DIR=$i"
+		break;
+	fi
+done
+
+echo
+echo "all:"

errno/errno.c

@@ -2,29 +2,56 @@
 #include <stdlib.h>
 #include <string.h>
 
+#include "errno_list.h"
+
+char errno_c_rcs_id[] = "$Id: errno.c,v 1.5 2003-02-27 13:28:45 hjp Exp $";
 char *cmnd;
 
-static void usage(void) {
-    fprintf(stderr, "Usage: %s errno ...\n", cmnd);
-    exit(1);
-}
-
-
 int main(int argc, char **argv) {
     int i;
 
     cmnd = argv[0];
 
     if (argc <= 1) {
-	int e;
-	for (e = 0;; e++) {
-	    printf("%d\t%s\n", e, strerror(e));
+	int i;
+	for (i = 0; i < wke_nr; i++) {
+	    int e = wke[i].number;
+	    char *d = wke[i].define;
+	    printf("%d\t%s\t%s\n", e, d, strerror(e));
 	}
     } else {
 	for (i = 1; i < argc; i++) {
-	    int e = strtoul(argv[i], NULL, 0);
+	    char *p;
+	    int e = strtoul(argv[i], &p, 0);
+
+	    if (*p) {
+		/* This is not a number, so we assume it is a define */
+		char *d = argv[i];
+		int j;
+
+		for (j = 0; j < wke_nr; j++) {
+		    if (strcmp(wke[j].define, d) == 0) {
+			e = wke[j].number;
+			printf("%d\t%s\t%s\n", e, d, strerror(e));
+			break;
+		    }
+		}
+
+	    } else {
+		/* it is a number */
+		char *d = "(unknown)";
+		int j;
+
+		for (j = 0; j < wke_nr; j++) {
+		    if (wke[j].number == e) {
+			d = wke[j].define;
+			break;
+		    }
+		}
+
+		printf("%d\t%s\t%s\n", e, d, strerror(e));
+	    }
 
-	    printf("%d\t%s\n", e, strerror(e));
 	}
     }
     return 0;

errno/errno.list

@@ -0,0 +1,137 @@
+E2BIG
+EACCES
+EADDRINUSE
+EADDRNOTAVAIL
+EADV
+EAFNOSUPPORT
+EAGAIN
+EALREADY
+EBADE
+EBADF
+EBADFD
+EBADMSG
+EBADR
+EBADRQC
+EBADSLT
+EBADVER
+EBFONT
+EBUSY
+ECANCELED
+ECHILD
+ECHRNG
+ECOMM
+ECONFIG
+ECONNABORTED
+ECONNREFUSED
+ECONNRESET
+EDEADLK
+EDEADLOCK
+EDESTADDRREQ
+EDOM
+EDOTDOT
+EDQUOT
+EEXIST
+EFAULT
+EFBIG
+EHOSTDOWN
+EHOSTUNREACH
+EIDRM
+EILSEQ
+EINPROGRESS
+EINTR
+EINVAL
+EIO
+EISCONN
+EISDIR
+EISNAM
+EL2HLT
+EL2NSYNC
+EL3HLT
+EL3RST
+ELIBACC
+ELIBBAD
+ELIBEXEC
+ELIBMAX
+ELIBSCN
+ELNRNG
+ELOOP
+EMEDIUMTYPE
+EMFILE
+EMLINK
+EMSGSIZE
+EMULTIHOP
+ENAMETOOLONG
+ENAVAIL
+ENETDOWN
+ENETRESET
+ENETUNREACH
+ENFILE
+ENOANO
+ENOBUFS
+ENOCSI
+ENODATA
+ENODEV
+ENOENT
+ENOEXEC
+ENOLCK
+ENOLINK
+ENOLOAD
+ENOMATCH
+ENOMEDIUM
+ENOMEM
+ENOMSG
+ENONET
+ENOPKG
+ENOPROTOOPT
+ENOREG
+ENOSPC
+ENOSR
+ENOSTR
+ENOSYM
+ENOSYS
+ENOTBLK
+ENOTCONN
+ENOTDIR
+ENOTEMPTY
+ENOTNAM
+ENOTSOCK
+ENOTSUP
+ENOTTY
+ENOTUNIQ
+ENOUNLD
+ENOUNREG
+ENXIO
+EOPNOTSUPP
+EOVERFLOW
+EPERM
+EPFNOSUPPORT
+EPIPE
+EPROTO
+EPROTONOSUPPORT
+EPROTOTYPE
+ERANGE
+EREFUSED
+ERELOC
+EREMCHG
+EREMOTE
+EREMOTEIO
+EREMOTERELEASE
+ERESTART
+EROFS
+ESHUTDOWN
+ESOCKTNOSUPPORT
+ESPIPE
+ESRCH
+ESRMNT
+ESTALE
+ESTRPIPE
+ETIME
+ETIMEDOUT
+ETOOMANYREFS
+ETXTBSY
+EUCLEAN
+EUNATCH
+EUSERS
+EWOULDBLOCK
+EXDEV
+EXFULL

errno/errno_list.h

@@ -0,0 +1,9 @@
+#include <stddef.h>
+
+typedef struct {
+    int number;
+    char *define;
+} errno_T;
+
+extern errno_T wke[];
+extern const size_t wke_nr;

errno/make_errno_list

@@ -0,0 +1,11 @@
+echo '#include <errno.h>' > errno_list.c
+echo '#include "errno_list.h"' >> errno_list.c
+echo 'errno_T wke[] = {' >> errno_list.c
+for e in `cat errno.list`
+do
+    echo "    #if defined($e)" >> errno_list.c
+    echo "        { $e, \"$e\" }," >> errno_list.c
+    echo "    #endif" >> errno_list.c
+done
+echo '};' >> errno_list.c
+echo 'const size_t wke_nr = sizeof(wke)/sizeof(wke[0]);' >> errno_list.c

filesize/filesize

@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use File::Find;
+
+my %seen;
+my %hist;
+
+sub collect {
+    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+	$atime,$mtime,$ctime,$blksize,$blocks) = lstat($_);
+    return if $seen{"$dev:$ino"};
+    $hist{$size}++;
+    $seen{"$dev:$ino"} = 1;
+}
+
+find(\&collect, @ARGV ? @ARGV : ("."));
+
+my $total_count;
+for my $c (values %hist) {
+    $total_count += $c;
+}
+
+my $ac = 0;
+for my $s (sort {$a <=> $b } keys %hist) {
+    $ac += $hist{$s};
+    printf "%g %g %6.2f\n", $s, $ac, 100 * $ac/$total_count;
+}
+

findproxy/findproxy

@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use LWP::UserAgent;
+use Time::HiRes qw(time);
+
+my $verbose = 0;
+
+my $ua = LWP::UserAgent->new();
+
+my @proxies;
+for my $proxy (@ARGV) {
+    print STDERR "trying proxy $proxy\n" if $verbose;
+    $ua->proxy('http', $proxy);
+    my $t0 = time();
+    my $response = $ua->get('http://www.hjp.at');
+    if ($response->is_success) {
+	my $dt = time() - $t0;
+	print STDERR "\tsucceded in $dt seconds\n" if $verbose;
+	push @proxies, [ $dt, $proxy ];
+    } else {
+	print STDERR "\tfailed\n" if $verbose;
+    }
+}
+
+if (@proxies) {
+    @proxies = sort { $a->[0] <=> $b->[0] } @proxies;
+    print $proxies[0]->[1], "\n";
+} else {
+    print STDERR "no proxies found\n" if $verbose;
+}

ftcp/GNUmakefile

@@ -0,0 +1,13 @@
+include GNUmakevars
+include GNUmakerules
+
+ftcp: ftcp.o
+	$(CC) $^ -o $@
+
+clean:
+	rm -f *.o ftcp core foo bar
+
+install: $(BINDIR)/ftcp
+
+distclean: clean
+	rm -f *.bak *.d

ftcp/ftcp.c

@@ -0,0 +1,105 @@
+char ftcp_rcs_id[] = 
+    "$Id: ftcp.c,v 1.1 2002-03-18 20:40:08 hjp Exp $";
+/* 
+    ftcp - fault tolerant copy
+
+    copy one file to another, ignoring any errors.
+    This is useful for copying files from defective media.
+ */
+#include <assert.h>
+#include <errno.h>
+#include <fcntl.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <sys/stat.h>
+#include <sys/types.h>
+#include <time.h>
+#include <unistd.h>
+
+#include <ant/io.h>
+#include <ant/string.h>
+
+char *cmnd;
+
+
+off_t skip_size = 512;
+size_t buf_size = 512;
+
+static void usage(void)
+{
+    fprintf(stderr, "Usage: %s [-s skip_size] source dest\n", cmnd);
+    exit(1);
+}
+
+
+static int ftcp(char const *src, char const *dest)
+{
+  int sfd, dfd, count;
+  char *buf;
+  off_t off = 0;
+
+  if ((buf = malloc(buf_size)) == NULL) {
+    return -1;
+  }
+  sfd = open(src, O_RDONLY);
+  if (sfd < 0)
+    return -1;
+  dfd = open(dest, O_WRONLY|O_CREAT|O_TRUNC, 0666);
+  if (dfd < 0)
+  {
+    close(sfd);
+    return -1;
+  }
+  for (;;) {
+    lseek(sfd, off, SEEK_SET);
+    count = read(sfd, buf, buf_size);
+    switch (count) {
+	case -1:
+	    fprintf(stderr, "%s: error at offset %lu: %s\n",
+	    	    cmnd, (unsigned long)off, strerror(errno));
+	    off += skip_size;
+	    break;
+	case 0:
+	    goto the_end;
+	default:
+	    lseek(dfd, off, SEEK_SET);
+	    write(dfd, buf, count);
+	    off += count;
+    }
+  }
+  the_end:
+	    
+  close(sfd);
+  close(dfd);
+  return 0;
+}
+
+
+
+int main(int argc, char **argv)
+{
+    int c;
+    char *p;
+
+    cmnd = argv[0];
+
+    while ((c = getopt(argc, argv, "s:")) != EOF) {
+	switch (c) {
+	case 's':
+            skip_size = strtoul(optarg, &p, 0);
+            if (p == optarg || *p != '\0') usage();
+            break;
+	case '?':
+	    usage();
+	default:
+	    assert(0);
+	}
+    }
+
+    if (optind != argc - 2) {
+	usage();
+    }
+    ftcp(argv[optind], argv[optind+1]);
+    return 0;
+}

grouptools/GNUmakefile

@@ -0,0 +1,36 @@
+include GNUmakevars
+
+CONFDIR=../../configure
+CONFDIR_exists=$(shell [ -d $(CONFDIR) ] && echo ok)
+
+all: configure grouplist groupmatch groupcount
+
+clean:
+	rm grouplist groupmatch
+
+install: \
+	$(BINDIR)/grouplist \
+	$(BINDIR)/groupmatch \
+	$(BINDIR)/groupcount \
+
+
+%: %.pl customize
+	sh ./customize < $< > $@
+	chmod +x $@
+
+customize: configure
+	sh ./configure
+
+ifeq ($(CONFDIR_exists),ok)
+
+configure: $(CONFDIR)/start $(CONFDIR)/perl $(CONFDIR)/finish
+	cat $^ > $@
+
+endif
+
+GNUmakevars: GNUmakevars.sh
+	sh ./$^ > $@
+GNUmakerules: GNUmakerules.pl
+	perl ./$^ > $@
+
+include GNUmakerules

grouptools/GNUmakerules.pl

@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+print "\$(BINDIR)/%: %\n";
+print "\tcp \$^ \$@\n";
+print "\$(MAN1DIR)/%: %\n";
+print "\tcp \$^ \$@\n";

grouptools/GNUmakerules.sh

@@ -0,0 +1,3 @@
+#!/bin/sh
+echo "\$(BINDIR)/%: %"
+echo -e "\tcp \$^ \$@"

grouptools/GNUmakevars.sh

@@ -0,0 +1,5 @@
+#!/bin/sh
+prefix=${prefix:-/usr/local}
+echo "BINDIR=$prefix/bin"
+echo
+echo "all:"

grouptools/configure

@@ -0,0 +1,34 @@
+#!/bin/sh
+#
+echo "#!/bin/sh" > customize.$$
+echo "sed \\" > customize.$$
+chmod +x customize.$$
+
+################################################################
+# find a working perl:
+#
+for i in /usr/bin/perl /usr/local/bin/perl /usr/bin/perl5 /usr/local/bin/perl5
+do
+    if $i -e 'exit ($] < 5.000)'
+    then
+	echo $i works
+	perl="$i"
+	break
+    fi
+done
+if [ -z "$perl" ]
+then
+    echo could not find a working perl command, sorry.
+    exit 1
+fi
+echo "  -e 's,@@@perl@@@,$perl,g' \\" >> customize.$$
+
+
+################################################################
+# finish
+#	Add trailing newline and rename temp file to final name
+#
+echo  >> customize.$$
+
+mv customize.$$ customize
+

grouptools/groupcount.pl

@@ -0,0 +1,52 @@
+#!@@@perl@@@ -w
+
+=head1 NAME
+
+groupcount - count number of groups of all users
+
+=head1 SYNOPSIS
+
+groupcount
+
+=head1 DESCRIPTION
+
+This script counts the number of groups each user is a member of.
+
+=head1 AUTHOR
+
+Peter J. Holzer <hjp@wsr.ac.at>
+
+=head1 SEE ALSO
+
+id(1)
+
+=cut
+
+use strict;
+use Getopt::Long;
+
+my $debug = 0;
+my $fullname = 0;
+GetOptions("debug" => \$debug,
+           "fullname" => \$fullname);
+           
+
+my $u = {};
+my $g = {};
+
+while (my @gr = getgrent()) {
+
+    my ($name,$passwd,$gid,$members) = @gr;
+    $g->{$gid} = $name;
+    for my $i (split(/ /, $members)) {
+	print STDERR "getgrent: $gid: $i\n" if($debug);
+	$u->{$i}{$name} = 1;
+    }
+}
+
+while (my @pw = getpwent()) {
+    my ($name,$passwd,$uid,$gid, $quota,$comment,$gcos,$dir,$shell,$expire) = @pw;
+    $u->{$name}{$g->{$gid}} = 1;
+    printf("%-10s %3d\n", $name, scalar(keys(%{$u->{$name}})));
+}
+

grouptools/grouplist.pl

@@ -0,0 +1,85 @@
+#!@@@perl@@@ -w
+
+=head1 NAME
+
+groulist - list all members of a group
+
+=head1 SYNOPSIS
+
+grouplist [--fullname] group
+
+=head1 DESCRIPTION
+
+This script lists all members of a group.
+For each user, the loginname, whether this is the primary or a supplemental group 
+of the user, and optionally the full name (from the GECOS field) is printed.
+
+=head2 Options
+
+=over 4
+
+=item --fullname
+
+Print the GECOS field.
+
+=item --debug
+
+Prints some debug output to stderr.
+
+=back
+
+=head1 AUTHOR
+
+Peter J. Holzer <hjp@wsr.ac.at>
+
+=head1 SEE ALSO
+
+id(1)
+
+=cut
+
+use strict;
+use Getopt::Long;
+
+my $debug = 0;
+my $fullname = 0;
+GetOptions("debug" => \$debug,
+           "fullname" => \$fullname);
+           
+
+my $u = {};
+
+my @gr;
+@gr = getgrnam($ARGV[0]);
+unless (@gr) {
+    print STDERR "$0: Group $ARGV[0] not found\n";
+    exit(1);
+}
+
+my ($name,$passwd,$gid,$members) = @gr;
+for my $i (split(/ /, $members)) {
+    print STDERR "getgrent: $gid: $i\n" if($debug);
+    $u->{$i}{s} = 1;
+}
+
+while (my @pw = getpwent()) {
+    my ($name,$passwd,$uid,$ugid, $quota,$comment,$gcos,$dir,$shell,$expire) = @pw;
+    print STDERR "getpwent: $ugid: $name\n" if($debug);
+    if ($ugid == $gid) {
+	$u->{$name}{p} = 1;
+	$u->{$name}{fn} = $gcos;
+    }
+}
+
+for my $i (keys %$u) {
+    printf("%-10s %1s%1s", $i, $u->{$i}{p} ? "p" : " ", $u->{$i}{s} ? "s" : " ");
+    if ($fullname) {
+	if (!$u->{$i}{fn}) {
+	    my @pw = getpwnam($i);
+	    my ($name,$passwd,$uid,$ugid, $quota,$comment,$gcos,$dir,$shell,$expire) = @pw;
+	    $u->{$i}{fn} = $gcos;
+	}
+	printf(" %s", $u->{$i}{fn});
+    }
+    print "\n";
+}

grouptools/groupmatch.pl

@@ -0,0 +1,128 @@
+#!@@@perl@@@ -w
+
+=head1 NAME
+
+groupmatch - find best matching group for list of users
+
+=head1 SYNOPSIS
+
+groupmatch [--cut value] [--allmembers] [--debug] [--miss value] user ...
+
+=head1 DESCRIPTION
+
+This script takes a list of users and prints the group(s) which 
+are the closest match (i.e. have the least number of missing or 
+superfluous users).
+
+For each group, the gid, group name, number of differences, and list of
+users which are missing (marked (-)) or too much (+) is printed.
+
+=head2 Options
+
+=over 4
+
+=item --cut value
+
+Sets the cutoff value. Only groups with at most this number of
+differences to the specified list of users are printed. By default the
+cutoff value is set so that only the best matching group(s) are printed.
+
+=item --allmembers
+
+Prints all members of the group, not only the differences to the
+specified list. Users which are already in the group are marked (*).
+
+=item --debug
+
+Prints some debug output to stderr.
+
+=item --miss value
+
+Penalty for missing users in a group. Default is 1, i.e., a user missing
+is just as bad as a superfluous user. Larger values bias towards groups
+with too many users, smaller values bias towards groups with too few users.
+
+=back
+
+=head1 AUTHOR
+
+Peter J. Holzer <hjp@wsr.ac.at>
+
+=head1 SEE ALSO
+
+id(1)
+
+=cut
+
+use strict;
+use Getopt::Long;
+
+sub diffsym {
+    my ($diff) = @_;
+    if ($diff == 0) { return "*"; }
+    if ($diff < 0)  { return "-"; }
+    if ($diff > 0)  { return "+"; }
+    return "?";
+}
+
+my $cut = undef;
+my $debug = 0;
+my $allmembers = 0;
+my $miss = 1;
+GetOptions("cut=i" => \$cut,
+           "debug" => \$debug,
+           "allmembers" => \$allmembers,
+	   "miss=f" => \$miss,
+          );
+my $gr = {};
+
+my @gr;
+while (@gr = getgrent) {
+    my ($name,$passwd,$gid,$members) = @gr;
+    for my $i (split(/ /, $members)) {
+	print STDERR "getgrent: $gid: $i\n" if($debug);
+	$gr->{$gid}->{Members}->{$i} = 1;
+	$gr->{$gid}->{Name} = $name;
+    }
+}
+my @pw;
+while (@pw = getpwent()) {
+    my ($name,$passwd,$uid,$gid, $quota,$comment,$gcos,$dir,$shell,$expire) = @pw;
+    print STDERR "getpwent: $gid: $name\n" if($debug);
+    $gr->{$gid}->{Members}->{$name} = 1;
+
+}
+for my $g (keys %$gr) {
+    for my $u (@ARGV) {
+	$gr->{$g}->{Members}->{$u} = (($gr->{$g}->{Members}->{$u} || 0) - 1) * $miss;
+    }
+    my $score = 0;
+    for my $u (keys(%{$gr->{$g}->{Members}})) {
+	$score += abs($gr->{$g}->{Members}->{$u});
+    }
+    print STDERR "$g: $score\n" if($debug);
+    $gr->{$g}->{Score} = $score;
+}
+if ($debug) {
+    print STDERR "\nScore list:\n";
+    for my $g (keys %$gr) {
+	print STDERR "$g: ", $gr->{$g}->{Score}, "\n";
+    }
+    print STDERR "\n";
+}
+
+for my $g (sort { $gr->{$a}->{Score} <=> $gr->{$b}->{Score} } keys %$gr) {
+    $cut = $gr->{$g}->{Score} unless ($cut);
+    next unless ($gr->{$g}->{Name});
+    last if ($gr->{$g}->{Score} > $cut);
+
+    print "$g: ",
+           $gr->{$g}->{Name}, ": ",
+           $gr->{$g}->{Score}, ": ";
+    for my $u (sort keys(%{$gr->{$g}->{Members}})) {
+	if ($allmembers || $gr->{$g}->{Members}->{$u}) {
+	    print "$u(", diffsym($gr->{$g}->{Members}->{$u}), ") ";
+	}
+    }
+    print "\n";
+}

hogs/cpuhog.c

@@ -0,0 +1,3 @@
+int main(void) {
+	for (;;);
+}

hogs/cpuhogt

@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+use v5.20;
+use warnings;
+
+use Time::HiRes qw(time);
+my $t0 = time;
+for (;;) {
+    my $dt = time - $t0;
+    last if $dt > $ARGV[0];
+}

hogs/malloc.c

@@ -0,0 +1,10 @@
+#include <stdlib.h>
+#include <stdio.h>
+
+int main(int argc, char **argv) {
+    size_t size = strtoul(argv[1], NULL, 0);
+    char *p = malloc(size);
+    printf("%zu bytes at %p\n", size, p);
+    sleep(10);
+    return 0;
+}

hogs/memhog.c

@@ -1,11 +1,15 @@
+#include <errno.h>
 #include <stdlib.h>
 #include <stdio.h>
+#include <string.h>
+
 int main(void) {
         size_t s = 0x100000;
 	size_t sum = 0;
 
         while (s) {
                 void *p;
+		errno = 0;
                 if (p = malloc(s)) {
 			sum += s;
                         printf("%lu - %lu\n",
@@ -15,6 +19,11 @@ int main(void) {
                         memset(p, 'a', s);
 			s *= 2;
                 } else {
+                        printf("%lu - %lu: %s\n",
+			       (unsigned long)s,
+			       (unsigned long)sum,
+			       strerror(errno)
+			      );
                         s /= 2;
                 }
         }

ieeefloat/.gitignore

@@ -0,0 +1 @@
+ieeefloat

ieeefloat/GNUmakefile

@@ -1,5 +1,4 @@
 include GNUmakevars
-include GNUmakerules
 
 all: ieeefloat
 install: $(BINDIR)/ieeefloat
@@ -8,6 +7,14 @@ clean:
 	rm -f *.bak *.o core ieeefloat
 
 distclean: clean
-	rm -f *.d
+	rm -f *.d GNUmakerules GNUmakevars
 
+ieeefloat: ieeefloat.o
+
+GNUmakevars: GNUmakevars.sh
+	sh ./$^ > $@
+GNUmakerules: GNUmakerules.sh
+	sh ./$^ > $@
+
+include GNUmakerules
 -include *.d

ieeefloat/GNUmakerules.sh

@@ -0,0 +1,5 @@
+#!/bin/sh
+echo "\$(BINDIR)/%: %"
+echo "\tcp \$^ \$@"
+echo "\$(MAN1DIR)/%: %"
+echo "\tcp \$^ \$@"

ieeefloat/GNUmakevars.sh

@@ -0,0 +1,15 @@
+#!/bin/sh
+prefix=${prefix:-/usr/local}
+echo "BINDIR=$prefix/bin"
+
+for i in "$prefix/share/man/man1" "$prefix/man/man1"
+do
+	if [ -d "$i" -a -w "$i" ]
+	then
+		echo "MAN1DIR=$i"
+		break;
+	fi
+done
+
+echo
+echo "all:"

ieeefloat/ieeefloat.c

@@ -1,9 +1,16 @@
 char ieeefloat_c_rcs_id[] = 
-    "$Id: ieeefloat.c,v 1.2 2000-02-08 17:04:37 hjp Exp $";
+    "$Id: ieeefloat.c,v 1.4 2003-07-17 10:36:49 hjp Exp $";
 /* ieeefloat: print binary representations of IEEE 754 FP numbers.
  *
  * $Log: ieeefloat.c,v $
- * Revision 1.2  2000-02-08 17:04:37  hjp
+ * Revision 1.4  2003-07-17 10:36:49  hjp
+ * Added <string.h>
+ * Added dependency to force .c -> .o compilation.
+ *
+ * Revision 1.3  2002/03/18 20:41:09  hjp
+ * Added format specifiers
+ *
+ * Revision 1.2  2000/02/08 17:04:37  hjp
  * Added -f and -d options to force input to be float or double format.
  *
  * Revision 1.1  1998/03/20 20:09:53  hjp
@@ -15,6 +22,7 @@ char ieeefloat_c_rcs_id[] =
 #include <limits.h>
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 
 
 #define BITS_FLT 32
@@ -50,9 +58,11 @@ typedef unsigned long long int doubleint;
 
 char *cmnd;
 
+char *floatformat  = "%24.7g";
+char *doubleformat = "%24.17g";
 
 static void usage(void) {
-    fprintf(stderr, "Usage: %s [-f|-d] fp-number ...\n", cmnd);
+    fprintf(stderr, "Usage: %s [-f|-d] [-F format] [-D format] fp-number ...\n", cmnd);
     exit(1);
 }
 
@@ -74,7 +84,8 @@ static void printfloat(float f) {
 
     u.f = f;
 
-    printf("%24.7g: ", f);
+    printf(floatformat, f);
+    printf(": ");
     printf("%c ", (u.i & SIGN_FLT) ? '-' : '+');
     u.i &= ~SIGN_FLT;
     e = u.i >> MANT_FLT;
@@ -102,7 +113,8 @@ static void printdouble(double f) {
 
     u.f = f;
 
-    printf("%24.17g: ", f);
+    printf(doubleformat, f);
+    printf(": ");
     printf("%c ", (u.i & SIGN_DBL) ? '-' : '+');
     u.i &= ~SIGN_DBL;
     e = u.i >> MANT_DBL;
@@ -169,6 +181,16 @@ int main(int argc, char**argv) {
 	} else if (strcmp(argv[i], "-d") == 0) {
 	    convfloat = 0;
 	    continue;
+	} else if (strcmp(argv[i], "-F") == 0) {
+	    if (!argv[i+1]) usage();
+	    floatformat = argv[i+1];
+	    i++;
+	    continue;
+	} else if (strcmp(argv[i], "-D") == 0) {
+	    if (!argv[i+1]) usage();
+	    doubleformat = argv[i+1];
+	    i++;
+	    continue;
 	} 
 
 	d = strtod(argv[i], &p);

ieeefloat/ulp

@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+my $x = $ARGV[0] + 0;
+
+my $d = 1;
+while ($x + $d == $x) {
+    $d *= 2;
+}
+while ($x + $d/2 != $x) {
+    $d /= 2;
+}
+
+printf "ulp+ = %.17e %.17e %.17e\n", $d, $x, $x + $d;
+
+$d = 1;
+while ($x - $d == $x) {
+    $d *= 2;
+}
+while ($x - $d/2 != $x) {
+    $d /= 2;
+}
+
+printf "ulp- = %.17e %.17e %.17e\n", $d, $x, $x - $d;

iptable_logs/hist

@@ -0,0 +1,19 @@
+#!/usr/local/bin/perl -w 
+use strict;
+use TimeSeries;
+use HTTP::Date qw(parse_date);
+
+my %hist = ();
+while (<>) {
+    my ($timestring, $rest) = m/(\w\w\w [ \d]\d \d\d:\d\d:\d\d) (.*)/;
+    my %p = /(\S+)=(\S+)/g;
+    my $bucket = $p{SRC} . " " . $p{DST};
+    if ($p{PROTO} eq "TCP" && $p{DPT} == 25 && ($p{SRC} =~ /^143.130\./)) {
+	$hist{$bucket}++;
+    } 
+}
+
+for (sort keys %hist) {
+    print "$_ $hist{$_}\n";
+}
+

iptable_logs/hist2

@@ -0,0 +1,24 @@
+#!/usr/local/bin/perl -w 
+use strict;
+use TimeSeries;
+use HTTP::Date qw(parse_date);
+
+my %hist = ();
+while (<>) {
+    my ($timestring, $rest) = m/(\w\w\w [ \d]\d \d\d:\d\d:\d\d) (.*)/;
+    my %p = /(\S+)=(\S+)/g;
+    if ($p{SRC} && ($p{SRC} =~ /^143.130\./)) {
+	my $bucket;
+	if ($p{PROTO} eq "ICMP") {
+	    $bucket = "$p{SRC} $p{DST} $p{PROTO} $p{TYPE}/$p{CODE}";
+	} else {
+	    $bucket = "$p{SRC} $p{DST} $p{PROTO} $p{DPT}";
+	}
+	$hist{$bucket}++;
+    } 
+}
+
+for (sort keys %hist) {
+    print "$_ $hist{$_}\n";
+}
+

iptable_logs/ts_dport

@@ -0,0 +1,25 @@
+#!/usr/local/bin/perl -w 
+use strict;
+use TimeSeries;
+use HTTP::Date qw(parse_date);
+
+my %hist = ();
+my $dport = shift;
+while (<>) {
+    my ($timestring, $rest) = m/(\w\w\w [ \d]\d \d\d:\d\d:\d\d) (.*)/;
+    my ($year, $mon, $day, $hour, $min, $sec, $zone)  
+	    = parse_date($timestring);
+    my $bucket = sprintf "%04d-%02d-%02dT%02d:00\n", $year, $mon, $day, $hour;
+    my %p = /(\S+)=(\S+)/g;
+    if ($dport == $p{DPT}) {
+	$hist{$bucket}++;
+    } else {
+	$hist{$bucket} += 0;
+    }
+}
+my $ts = TimeSeries->new();
+$ts->legend("Connects to port $dport");
+for (sort keys %hist) {
+    $ts->add_timestring($_, $hist{$_});
+}
+print $ts->plot();

jetdirectprint/jetdirectprint

@@ -0,0 +1,85 @@
+#!/usr/bin/perl
+#  Direct-to-printer (old HP Jetdirect style printers) filter
+#  to integrate with rhs-printfilters.  
+#  Supplied by Joshua Buysse, University of Minnesota
+
+# needs perl 5.004 for IO:Socket
+require 5.004;
+
+# Maximum number of times to retry connection
+$max_retries = 3600; # at one second each, one hour.
+
+# needed for the dirname() function
+use File::Basename;
+use IO::Socket;
+
+$config_file = "script.cfg";
+
+open(CONFIG, $config_file) || die "No config file found!";
+
+while (<CONFIG>) {
+  chomp;
+  s/#.*//;     # no comments
+  s/^\s+//;    # no leading white
+  s/\s+$//;    # no trailing white
+
+  # If there's nothing left, we're done.
+  next unless length;
+
+  # split the fields
+  my ($key,$value) = split /\s*=\s*/, $_, 2;
+
+  $config{$key} = $value;
+}
+
+
+# the config hash should contain port and printer_ip as keys
+
+# if the port isn't set, use the default of 9100
+$config{'port'} = 9100 unless $config{'port'};
+$config{'printer_ip'} || die "Config file does not specify printer IP.";
+
+# now, open a socket to the printer.
+
+$retry_count = 0;
+
+do {
+  $socket = IO::Socket::INET->new(PeerAddr => $config{'printer_ip'},
+  				  PeerPort => $config{'port'},
+				  Proto    => "tcp",
+				  Type     => SOCK_STREAM);
+  if (! $socket) {
+    sleep 1;
+    $retry_count++;
+  }
+} until ($socket || ($retry_count > $max_retries));
+
+$socket || die "Unable to open socket after $retry_count retries.";
+
+for (;;) {
+    my ($rin, $win, $ein);
+    my ($rout, $wout, $eout);
+    $rin = $win = $ein = '';
+    vec($rin,fileno(STDIN),1) = 1;
+    vec($rin,fileno($socket),1) = 1;
+    $ein = $rin | $win;
+
+    my ($nfound,$timeleft) =
+    	select($rout=$rin, $wout=$win, $eout=$ein, $timeout);
+    if (vec($rout,fileno(STDIN),1)) {
+	sysread(STDIN, $buf, 1024) or last;
+	print $socket $buf
+	    or die "${config{'printer_ip'}}:${config{'port'}}: $!";
+    }
+    if (vec($rout,fileno($socket),1)) {
+	sysread($socket, $buf, 1024) or last;
+	print STDERR "$0: ${config{'printer_ip'}}:${config{'port'}}: $buf\n";
+    }
+}
+	
+close($socket);
+
+
+
+
+

lspath/GNUmakefile

@@ -21,5 +21,10 @@ customize: configure
 $(BINDIR):
 	mkdir -p $@
 
-include GNUmakerules
 
+GNUmakevars: GNUmakevars.sh
+	sh ./$^ > $@
+GNUmakerules: GNUmakerules.sh
+	sh ./$^ > $@
+
+include GNUmakerules

lspath/GNUmakerules.sh

@@ -0,0 +1,3 @@
+#!/bin/sh
+echo "\$(BINDIR)/%: %"
+echo -e "\tcp \$^ \$@"

lspath/GNUmakevars.sh

@@ -0,0 +1,5 @@
+#!/bin/sh
+prefix=${prefix:-/usr/local}
+echo "BINDIR=$prefix/bin"
+echo
+echo "all:"

lspath/lspath.pl

@@ -1,14 +1,26 @@
-#!@@@perl@@@ -w
+#!@@@perl@@@
+use warnings;
 use strict;
 
+use Getopt::Long;
 
+my $suffix = "";
+
+GetOptions(
+    "suffix:s" => \$suffix,
+);
+
+
+my @pp;
 for my $p (@ARGV) {
 
     my @p = split (/\//, $p);
     for (my $i = 0; $i < scalar(@p); $i++) {
 	my $pp = join("/", @p[0..$i]);
 	$pp = "/" if $pp eq "";
+        $pp .= $suffix;
 
-	system("/bin/ls", "-ldi", $pp);
+	push (@pp, $pp);
     }
 }
+system("/bin/ls", "-fldi", @pp);

multiping/multiping

@@ -0,0 +1,32 @@
+#!/usr/bin/perl 
+use warnings;
+use strict;
+
+use IO::Select;
+
+my $s = IO::Select->new();
+
+my %fh2host;
+my $len = 0;
+for my $host (@ARGV) {
+    open(my $fh, '-|', 'ping', $host) or die "cannot exec ping: $!";
+    $s->add($fh);
+    $fh2host{$fh} = $host;
+    $len = length($host) if length($host) > $len;
+}
+my %state;
+
+for (;;) {
+    my @ready = $s->can_read(1);
+    for my $fh (@ready) {
+	my $msg = <$fh>;
+	chomp($msg);
+	my $host = $fh2host{$fh};
+	$state{$host} = $msg;
+    }
+    print "\n\n";
+    for my $host (@ARGV) {
+	no warnings 'uninitialized';
+	printf("%-*s : %s\n", $len, $host, $state{$host});
+    }
+}

notify/test-basic.c

@@ -0,0 +1,25 @@
+#include <libnotify/notify.h>
+#include <stdio.h>
+#include <unistd.h>
+
+int main(int argc, char * argv[] ) 
+{
+    NotifyNotification *n;  
+
+    notify_init("Basics");
+
+    n = notify_notification_new ("Summary", 
+                                 "This is the message that we want to display",
+                                  NULL, NULL);
+    notify_notification_set_timeout (n, 5000); // 5 seconds
+
+    if (!notify_notification_show (n, NULL)) 
+    {
+	fprintf(stderr, "failed to send notification\n");
+	return 1;
+    }
+
+    g_object_unref(G_OBJECT(n));
+
+    return 0;
+}

obwrap/GNUmakefile

@@ -1,4 +1,4 @@
-include GNUmakerules
+include GNUmakevars
 
 all: obwrap
 
@@ -6,3 +6,5 @@ errno:
 clean:
 	rm obwrap
 install: $(BINDIR)/obwrap
+
+include GNUmakerules

obwrap/obwrap.c

@@ -1,5 +1,5 @@
 char obwrap_c_rcsid[] = 
-	"$Id: ";
+	"$Id: obwrap.c,v 1.3 2004-09-06 08:37:03 hjp Exp $";
 /* obwrap - wrapper for omniback scripts 
  *
  * Omniback leaves a lot of file descriptors open when executing its
@@ -7,13 +7,16 @@ char obwrap_c_rcsid[] =
  * from such a script (e.g., oracle) will have open file descriptors
  * on /var/opt/omni, which is a bad thing.
  * This program closes all file descriptors except stdin and stdout,
- * changes uid (if -u is given) and executes the specified program.
+ * changes uid (if -u is given), chdirs to the root directory and
+ * executes the specified program.
  */
 #include <errno.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
 #include <pwd.h>
+#include <grp.h>
+#include <fcntl.h>
 #include <unistd.h>
 
 #define nonstderr stdout	/* Omniback bogosity */
@@ -38,7 +41,6 @@ int main(int argc, char **argv) {
 	    case 'u': {
 		char *p;
 		uid_t uid;
-		gid_t gid;
 
 		uid = strtol(optarg, &p, 0);
 		if (*p != '\0') {
@@ -78,12 +80,20 @@ int main(int argc, char **argv) {
     }
     if (optind == argc) usage();
 
+    /* close all filedescriptors except stdout,
+     * redirect stdin from /dev/null,
+     * stderr from stdout
+     */
+    close(0);
+    open("/dev/null", O_RDONLY);
     for (i = 2; i < open_max; i++) {
 	close(i);
     }
 
     dup2(1, 2);
 
+    chdir("/");
+
     execv(argv[optind], argv + optind + 1);
     fprintf(nonstderr, "%s: could not exec %s: %s\n",
     		cmnd, argv[optind], strerror(errno));

open_mode/GNUmakefile

@@ -0,0 +1,6 @@
+CC = gcc -std=c99
+
+open_mode:
+
+clean:
+	rm open_mode

open_mode/open_mode.c

@@ -0,0 +1,58 @@
+#define _GNU_SOURCE 1
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <stdlib.h>
+
+struct {
+    int mode;
+    char *name;
+} modes[] = {
+    { O_APPEND, "O_APPEND" },
+    { O_ASYNC, "O_ASYNC" },
+    { O_CLOEXEC, "O_CLOEXEC" },
+    { O_CREAT, "O_CREAT" },
+    { O_DIRECT, "O_DIRECT" },
+    { O_DIRECTORY, "O_DIRECTORY" },
+    { O_EXCL, "O_EXCL" },
+    { O_LARGEFILE, "O_LARGEFILE" },
+    { O_NOATIME, "O_NOATIME" },
+    { O_NOCTTY, "O_NOCTTY" },
+    { O_NOFOLLOW, "O_NOFOLLOW" },
+    { O_NONBLOCK, "O_NONBLOCK" },
+    { O_NDELAY, "O_NDELAY" },
+    { O_SYNC, "O_SYNC" },
+    { O_TRUNC, "O_TRUNC" },
+};
+void dump_mode(int mode) {
+    if ((mode & 3) == O_RDONLY) {
+	printf("%7o %s\n", O_RDONLY, "O_RDONLY");
+    } else
+    if ((mode & 3) == O_WRONLY) {
+	printf("%7o %s\n", O_WRONLY, "O_WRONLY");
+    } else
+    if ((mode & 3) == O_RDWR) {
+	printf("%7o %s\n", O_RDWR, "O_RDWR");
+    } else {
+	printf("%7o %s\n", (mode & 3), "none");
+    }
+
+    for (int i = 0; i < sizeof(modes)/sizeof(modes[0]); i++) {
+	if (modes[i].mode & mode) {
+	    printf("%7o %s\n", modes[i].mode, modes[i].name);
+	}
+    }
+    printf("\n");
+}
+
+int main(int argc, char **argv) {
+    if (argc == 1) {
+	dump_mode(-1);
+    } else {
+	for (char **arg = argv+1; *arg; arg++) {
+	    int mode = strtoul(*arg, NULL, 0);
+	    dump_mode(mode);
+	}
+    }
+}

openrandomfile/openrandomfile

@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use Time::HiRes qw(time);
+
+chdir "/" or die;
+my $finished;
+
+my $depth = 0;
+while (!$finished) {
+    my $t0 = time;
+    opendir my $dh, ".";
+    my @files = grep !m/^\.\.?$/, readdir($dh);
+    last unless @files;
+    my $file = $files[rand(@files)];
+    if (-d $file) {
+	if (chdir($file)) {
+	    # continue
+	} else {
+	    $finished = 1;
+	}
+    } else {
+	my $buf;
+	if (open (my $fh, '<', $file)) {
+	    read($fh, $buf, 1);
+	}
+	$finished = 1;
+    }
+    my $t1 = time;
+    printf "%2d %s: %g\n", ++$depth, $file, $t1 - $t0;
+}

oragetsrc/GNUmakefile

@@ -1,6 +1,7 @@
 include GNUmakevars
 
 CONFDIR=../../configure
+CONFDIR_exists=$(shell [ -d $(CONFDIR) ] && echo ok)
 
 all: configure oragetsrc
 
@@ -20,9 +21,13 @@ install: $(BINDIR) $(BINDIR)/oragetsrc
 customize: configure
 	sh ./configure
 
+ifeq ($(CONFDIR_exists),ok)
+
 configure: $(CONFDIR)/start $(CONFDIR)/perl $(CONFDIR)/finish
 	cat $^ > $@
 
+endif
+
 $(BINDIR):
 	mkdir -p $@
 

oragetsrc/oragetsrc.pl

@@ -1,6 +1,6 @@
 #!@@@perl@@@ -w
 
-# $Id: oragetsrc.pl,v 1.1 2001-02-12 14:32:43 hjp Exp $
+# $Id: oragetsrc.pl,v 1.2 2002-06-18 15:10:59 hjp Exp $
 #
 # print a named source (e.g, a function or procedure) from an oracle schema
 #
@@ -35,6 +35,7 @@ my @cred = read_cred("$ENV{HOME}/.dbi/$ARGV[0]");
 my $dbh = DBI->connect($cred[0], $cred[1], $cred[2],
 			    { RaiseError => 1, AutoCommit => 0 });
 
+# check if it is a procedure or function
 my $lines =
     $dbh->selectcol_arrayref(
 	"select text from user_source where name=? order by line",
@@ -42,8 +43,27 @@ my $lines =
 	$src_name
     );
 
+if (@$lines) {
     for my $i (@$lines) {
 	print "$i";
     }
+    exit(0);
+}
+
+# nope - maybe a trigger?
+
+$dbh->{LongReadLen} = 1000000;
+$dbh->{LongTruncOk} = 0;
+my $sth = $dbh->prepare("select description, trigger_body from user_triggers where trigger_name=?");
+$sth->execute($src_name);
+my $found = 0;
+while (my $r = $sth->fetchrow_hashref("NAME_lc")) {
+    print "TRIGGER ", $r->{description}, "\n", $r->{trigger_body}, "\n";;
+    $found = 1;
+}
+
+exit(0) if ($found);
+
 $dbh->disconnect();
 
+exit(1);

pathtools/GNUmakefile

@@ -0,0 +1,55 @@
+include GNUmakevars
+
+TARGETS = apppath preppath delpath apppath.1 preppath.1 delpath.1
+CONFDIR=../../configure
+CONFDIR_exists=$(shell [ -d $(CONFDIR) ] && echo ok)
+
+all: configure $(TARGETS)
+
+clean:
+	rm -f $(TARGETS) *.bak core foo bar baz *.ps
+
+distclean: clean
+	rm -f customize GNUmakerules GNUmakevars
+
+install: $(BINDIR) \
+    $(BINDIR)/apppath \
+    $(BINDIR)/preppath \
+    $(BINDIR)/delpath \
+    $(MAN1DIR) \
+    $(MAN1DIR)/apppath.1 \
+    $(MAN1DIR)/preppath.1 \
+    $(MAN1DIR)/delpath.1 \
+
+
+%.1: %.pl
+	pod2man $< > $@
+
+%: %.pl customize
+	sh ./customize < $< > $@
+	chmod +x $@
+
+%: %.sh customize
+	sh ./customize < $< > $@
+	chmod +x $@
+
+customize: configure
+	sh ./configure
+
+$(BINDIR) $(MAN1DIR):
+	mkdir -p $@
+
+ifeq ($(CONFDIR_exists),ok)
+
+configure: $(CONFDIR)/start $(CONFDIR)/perl $(CONFDIR)/finish
+	cat $^ > $@
+
+endif
+
+GNUmakevars: GNUmakevars.sh
+	sh ./$^ > $@
+GNUmakerules: GNUmakerules.pl
+	perl ./$^ > $@
+
+
+include GNUmakerules

pathtools/GNUmakerules.pl

@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+print "\$(BINDIR)/%: %\n";
+print "\tcp \$^ \$@\n";
+print "\$(MAN1DIR)/%: %\n";
+print "\tcp \$^ \$@\n";

pathtools/GNUmakerules.sh

@@ -0,0 +1,5 @@
+#!/bin/sh
+echo "\$(BINDIR)/%: %"
+echo -e "\tcp \$^ \$@"
+echo "\$(MAN1DIR)/%: %"
+echo -e "\tcp \$^ \$@"

pathtools/GNUmakevars.sh

@@ -0,0 +1,15 @@
+#!/bin/sh
+prefix=${prefix:-/usr/local}
+echo "BINDIR=$prefix/bin"
+
+for i in "$prefix/share/man/man1" "$prefix/man/man1"
+do
+	if [ -d "$i" -a -w "$i" ]
+	then
+		echo "MAN1DIR=$i"
+		break;
+	fi
+done
+
+echo
+echo "all:"

pathtools/apppath.pl

@@ -0,0 +1,87 @@
+#!@@@perl@@@ -w
+
+=head1 NAME
+
+apppath - append directories to path
+
+=head1 SYNOPSIS
+
+apppath [-c] [-v variable] directory...
+
+=head1 DESCRIPTION
+
+apppath appends the directories given as arguments to the PATH and
+prints the new path on stdout.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-c>
+
+Check whether the directories exist before adding them. Nonexistent
+directories are silently ignored.
+
+=item B<-v> I<variable>
+
+Use the environment variable I<variable> instead of PATH.
+This is useful for manipulating other PATH-like variables, like
+LD_LIBRARY_PATH, PERL5LIB, etc.
+
+=item B<-e>
+
+Print a complete export statement ready to be eval'd by a POSIX shell.
+
+=item B<-p>
+
+Print a complete variable assignment statement ready to be eval'd by a
+POSIX shell. Unlike the C<-e> option this  does not prepend the export
+keyword, so the variable is private unless it is exported elsewhere.
+
+=back
+
+=head1 AUTHOR
+
+Peter J. Holzer <hjp@hjp.at>.
+
+=cut
+
+use strict;
+use Getopt::Long;
+
+my $check;
+my $debug;
+my $var = 'PATH';
+my $export;
+my $private;
+GetOptions("check"   => \$check,
+           "debug"   => \$debug,
+           "var=s"   => \$var,
+           "export"  => \$export,
+           "private" => \$private,
+          ) or do {
+                require Pod::Usage;
+                import Pod::Usage;
+                pod2usage(2);
+            };
+
+my $path = $ENV{$var} || '';
+my @path = split(/:/, $path);
+
+if ($#ARGV == 0 && $ARGV[0] =~ /:/) {
+    @ARGV = split(/:/, $ARGV[0]);
+}
+
+nd: for my $nd (@ARGV) {
+    for my $od (@path) {
+	next nd if ($nd eq $od);
+    }
+    push @path, $nd if (!$check || -d $nd);
+}
+if ($export) {
+    print "export ";
+}
+if ($export || $private) {
+    print "$var=";
+}
+print join(':', @path), "\n";

pathtools/configure

@@ -0,0 +1,34 @@
+#!/bin/sh
+#
+echo "#!/bin/sh" > customize.$$
+echo "sed \\" > customize.$$
+chmod +x customize.$$
+
+################################################################
+# find a working perl:
+#
+for i in /usr/bin/perl /usr/local/bin/perl /usr/bin/perl5 /usr/local/bin/perl5
+do
+    if $i -e 'exit ($] < 5.000)'
+    then
+	echo $i works
+	perl="$i"
+	break
+    fi
+done
+if [ -z "$perl" ]
+then
+    echo could not find a working perl command, sorry.
+    exit 1
+fi
+echo "  -e 's,@@@perl@@@,$perl,g' \\" >> customize.$$
+
+
+################################################################
+# finish
+#	Add trailing newline and rename temp file to final name
+#
+echo  >> customize.$$
+
+mv customize.$$ customize
+

pathtools/delpath.pl

@@ -0,0 +1,78 @@
+#!@@@perl@@@ -w
+
+=head1 NAME
+
+delpath - delete directories from path
+
+=head1 SYNOPSIS
+
+delpath [-v variable] directory...
+
+=head1 DESCRIPTION
+
+delpath deletes the directories given as arguments from the PATH and
+prints the new path on stdout.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-v> I<variable>
+
+Use the environment variable I<variable> instead of PATH.
+This is useful for manipulating other PATH-like variables, like
+LD_LIBRARY_PATH, PERL5LIB, etc.
+
+=item B<-e>
+
+Print a complete export statement ready to be eval'd by a POSIX shell.
+
+=item B<-p>
+
+Print a complete variable assignment statement ready to be eval'd by a
+POSIX shell. Unlike the C<-e> option this  does not prepend the export
+keyword, so the variable is private unless it is exported elsewhere.
+
+=back
+
+=head1 AUTHOR
+
+Peter J. Holzer <hjp@hjp.at>.
+
+=cut
+
+use strict;
+use Getopt::Long;
+use Pod::Usage;
+
+my $debug;
+my $var = 'PATH';
+my $export;
+my $private;
+GetOptions("debug"   => \$debug,
+           "var=s"   => \$var,
+           "export"  => \$export,
+           "private" => \$private,
+          ) or pod2usage(2);
+
+if ($#ARGV == 0 && $ARGV[0] =~ /:/) {
+    @ARGV = split(/:/, $ARGV[0]);
+}
+
+my $path = $ENV{$var};
+my @path = split(/:/, $path);
+
+my %del;
+for (@del{@ARGV}) {
+    $_ = 1;
+}
+
+@path = grep { !$del{$_} } @path;
+
+if ($export) {
+    print "export ";
+}
+if ($export || $private) {
+    print "$var=";
+}
+print join(':', @path), "\n";

pathtools/preppath.pl

@@ -0,0 +1,103 @@
+#!@@@perl@@@ -w
+
+=head1 NAME
+
+preppath - prepend directories to path
+
+=head1 SYNOPSIS
+
+preppath [-c] [-v variable] directory...
+
+=head1 DESCRIPTION
+
+preppath prepends the directories given as arguments to the PATH,
+eliminates  any duplicates and prints the new path on stdout. 
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-c>
+
+Check whether the directories exist before adding them. Nonexistent
+directories are silently ignored.
+
+=item B<-v> I<variable>
+
+Use the environment variable I<variable> instead of PATH.
+This is useful for manipulating other PATH-like variables, like
+LD_LIBRARY_PATH, PERL5LIB, etc.
+
+=item B<-e>
+
+Print a complete export statement ready to be eval'd by a POSIX shell.
+
+=item B<-p>
+
+Print a complete variable assignment statement ready to be eval'd by a
+POSIX shell. Unlike the C<-e> option this  does not prepend the export
+keyword, so the variable is private unless it is exported elsewhere.
+
+=item B<-r>
+
+Reverse order of arguments. This is useful if you have several versions
+of a software installed and you want the one with the highest version
+number first in your path.
+
+=back
+
+=head1 AUTHOR
+
+Peter J. Holzer <hjp@hjp.at>.
+
+=cut
+
+use strict;
+use Getopt::Long;
+
+my $check;
+my $debug;
+my $var = 'PATH';
+my $export;
+my $private;
+my $reverse;
+GetOptions("check"   => \$check,
+           "debug"   => \$debug,
+           "var=s"   => \$var,
+           "export"  => \$export,
+           "private" => \$private,
+           "reverse" => \$reverse,
+          ) or do {
+                require Pod::Usage;
+                import Pod::Usage;
+                pod2usage(2);
+            };
+
+my $path = $ENV{$var} || '';
+my @path = split(/:/, $path);
+
+if ($#ARGV == 0 && $ARGV[0] =~ /:/) {
+    @ARGV = split(/:/, $ARGV[0]);
+}
+
+if ($reverse) {
+    @ARGV = reverse @ARGV;
+}
+
+my %seen;
+my @newpath;
+
+for my $d (@ARGV, @path) {
+    if (!$seen{$d} && (!$check || -d $d)) {
+	push @newpath, $d;
+	$seen{$d} = 1;
+    }
+}
+
+if ($export) {
+    print "export ";
+}
+if ($export || $private) {
+    print "$var=";
+}
+print join(':', @newpath), "\n";

prwtmp/GNUmakefile

@@ -5,12 +5,11 @@ prwtmp:
 
 install: $(ROOT)/usr/local/bin/prwtmp $(ROOT)/usr/local/man/man8/prwtmp.8
 
-install_all:
-	$(MAKE) install ROOT=/nfs/wsrdb
-	$(MAKE) install ROOT=/nfs/wsrcom
-	$(MAKE) install ROOT=/nfs/wifosv
-	$(MAKE) install ROOT=/nfs/ihssv
-	$(MAKE) install ROOT=/nfs/wsrtest
+clean:
+	rm prwtmp
+
+distclean: clean
+	rm GNUmakerules GNUmakevars
 
 $(ROOT)/usr/local/bin/%: %
 	$(INSTALL) $< $@
@@ -18,5 +17,8 @@ $(ROOT)/usr/local/bin/%: %
 $(ROOT)/usr/local/man/man8/%.8: %.man
 	$(INSTALL) $< $@
 
-clean:
-	rm prwtmp
+GNUmakevars: GNUmakevars.sh
+	sh ./$^ > $@
+GNUmakerules: GNUmakerules.pl
+	perl ./$^ > $@
+