--- /dev/null
+================================================================================
+
+ Duplicate Mail Checker @VERSION@
+
+ (c) 2006 Martin Mares <mj@ucw.cz>
+
+================================================================================
+
+This package tries to solve two problems which were plaguing my mail-box for
+a long time:
+
+(1) In many cases, a single message arrives in several copies through different
+ paths. The copies usually share a single Message-ID, so I decided to scan
+ incoming mail for duplicate Message-ID's (for this purpose, I am willing
+ to believe that SHA-1 is a perfect hash function).
+
+(2) Copies of messages originated by me frequently loop back to me. This could
+ be handled by recording Message-ID's of outgoing mail, thus reducing it
+ to the previous problem, but unfortunately this is not applicable to my
+ situation as I send mail from multiple machines (not all of them on-line
+ all the time). However, there is an easier solution: generate special
+ Message-ID's for all my outgoing mail, so it can be easily recognized.
+ (It's tempting to use the From field for such purposes, but that has
+ its own problems -- for example, I want to exclude all mail generated
+ by scripts and sent through other ways than my MUA, since such mail is
+ not recorded to the outbox when sending.)
+
+ For this purpose, I use Message-ID: <USER+md-YYYYMMDD.HHMMSS.PID.HOST@DOMAIN>,
+ where USER@DOMAIN is my mail address and HOST is the machine I've sent the mail
+ from (to avoid potential duplicates when sending from multiple machines).
+
+So I have written the `mdup' utility which receives mail headers on its standard
+input, parses them, records a SHA-1 hash of the Message-ID in a database and
+prints a verdict to the standard output:
+
+ DUP Message-ID already known
+ LOCAL Message-ID recognized as originated by me
+ OK Message-ID not recognized
+ NO ID The message has no ID
+ ERROR Some other error occured
+
+(things like the USER and DOMAIN for detection of local mail or lifetime of all
+database records get passed as command-line options).
+
+This can be easily used in procmail rules:
+
+ DUPS=`bin/mdup -lmj@ucw.cz`
+
+ :0
+ * DUPS ?? LOCAL
+ Mail/looped_back
+
+ :0
+ * DUPS ?? DUP
+ Mail/duplicates
+
+The only remaining problem is how to set the Message-ID for outgoing mail.
+I have written a sendmail wrapper (smail.c) for this purpose, but then I
+realized that this way the Message-ID's don't get recorded properly in the
+sent mail folder, breaking all threading. However, if you use Mutt, there
+is a neat (but a little devilish) trick how to generate Message-ID's using
+just the Mutt's configuration language:
+
+send-hook .* my_hdr Message-Id: <USER+md-\`date -u '+%Y%m%d.%H%M%S.$$.$HOSTNAME'\`@DOMAIN>
+
+(Note the backslashes -- they cause the backticks to be interpolated when the
+hook gets executed instead of when it gets parsed.)
+
+Please send all bug reports and suggestions to mj@ucw.cz.
+
+ Have fun
+ Martin
+
+LICENSE
+~~~~~~~
+This program can be distributed and used according to the terms of the
+GNU General Public License version 2 or newer.
+
+CAVEATS
+~~~~~~~
+`mdup' assumes that the ID hash database (by default located in ~/.mdup.db)
+can be locked by flock(), so if your home directory is shared over NFS,
+strange things might (and probably will) happen. Better don't do that.
--- /dev/null
+#!/usr/bin/perl
+# A simple system for making software releases
+# (c) 2003 Martin Mares <mj@ucw.cz>
+
+package UCW::Release;
+use strict;
+use warnings;
+use Getopt::Long;
+
+our $verbose = 0;
+
+sub new($$) {
+ my ($class,$basename) = @_;
+ my $s = {
+ "PACKAGE" => $basename,
+ "rules" => [
+ # p=preprocess, s=subst, -=discard
+ '(^|/)(CVS|\.arch-ids|{arch}|tmp)/' => '-',
+ '\.(lsm|spec)$' => 'ps',
+ '(^|/)README$' => 's'
+ ],
+ "directories" => [
+ ],
+ "conditions" => {
+ },
+ "DATE" => `date '+%Y-%m-%d' | tr -d '\n'`,
+ "LSMDATE" => `date '+%y%m%d' | tr -d '\n'`,
+ "distfiles" => [
+ ],
+ "archivedir" => "/home/mj/tmp/archives/$basename",
+ "uploads" => [
+ ],
+ # Options
+ "do_test" => 1,
+ "do_patch" => 1,
+ "diff_against" => "",
+ "do_upload" => 1
+ };
+ bless $s;
+ return $s;
+}
+
+sub GetVersionFromFile($) {
+ my ($s,$file,$rx) = @_;
+ open F, $file or die "Unable to open $file for version autodetection";
+ while (<F>) {
+ chomp;
+ if (/$rx/) {
+ $s->{"VERSION"} = $1;
+ print "Detected version $1 from $file\n" if $verbose;
+ last;
+ }
+ }
+ close F;
+ if (!defined $s->{"VERSION"}) { die "Failed to auto-detect version"; }
+ return $s->{"VERSION"};
+}
+
+sub GetVersionsFromChangelog($) {
+ my ($s,$file,$rx) = @_;
+ open F, $file or die "Unable to open $file for version autodetection";
+ while (<F>) {
+ chomp;
+ if (/$rx/) {
+ if (!defined $s->{"VERSION"}) {
+ $s->{"VERSION"} = $1;
+ print "Detected version $1 from $file\n" if $verbose;
+ } elsif ($s->{"VERSION"} eq $1) {
+ # do nothing
+ } else {
+ $s->{"OLDVERSION"} = $1;
+ print "Detected previous version $1 from $file\n" if $verbose;
+ last;
+ }
+ }
+ }
+ close F;
+ if (!defined $s->{"VERSION"}) { die "Failed to auto-detect version"; }
+ return $s->{"VERSION"};
+}
+
+sub InitDist($) {
+ my ($s,$dd) = @_;
+ $s->{"DISTDIR"} = $dd;
+ print "Initializing dist directory $dd\n" if $verbose;
+ `rm -rf $dd`; die if $?;
+ `mkdir -p $dd`; die if $?;
+}
+
+sub ExpandVar($$) {
+ my ($s,$v) = @_;
+ if (defined $s->{$v}) {
+ return $s->{$v};
+ } else {
+ die "Reference to unknown variable $v";
+ }
+}
+
+sub CopyFile($$$$) {
+ my ($s,$f,$dir,$action) = @_;
+
+ (my $d = $f) =~ s@(^|/)[^/]*$@@;
+ $d = "$dir/$d";
+ -d $d || `mkdir -p $d`; die if $?;
+
+ my $preprocess = ($action =~ /p/);
+ my $subst = ($action =~ /s/);
+ if ($preprocess || $subst) {
+ open I, "$f" or die "open($f): $?";
+ open O, ">$dir/$f" or die "open($dir/$f): $!";
+ my @ifs = (); # stack of conditions, 1=satisfied
+ my $empty = 0; # last line was empty
+ my $is_makefile = ($f =~ /(Makefile|.mk)$/);
+ while (<I>) {
+ if ($subst) {
+ s/@([0-9A-Za-z_]+)@/$s->ExpandVar($1)/ge;
+ }
+ if ($preprocess) {
+ if (/^#/ || $is_makefile) {
+ if (/^#?ifdef\s+(\w+)/) {
+ if (defined ${$s->{"conditions"}}{$1}) {
+ push @ifs, ${$s->{"conditions"}}{$1};
+ next;
+ }
+ push @ifs, 0;
+ } elsif (/^#ifndef\s+(\w+)/) {
+ if (defined ${$s->{"conditions"}}{$1}) {
+ push @ifs, -${$s->{"conditions"}}{$1};
+ next;
+ }
+ push @ifs, 0;
+ } elsif (/^#if\s+/) {
+ push @ifs, 0;
+ } elsif (/^#?endif/) {
+ my $x = pop @ifs;
+ defined $x or die "Improper nesting of conditionals";
+ $x && next;
+ } elsif (/^#?else/) {
+ my $x = pop @ifs;
+ defined $x or die "Improper nesting of conditionals";
+ push @ifs, -$x;
+ $x && next;
+ }
+ }
+ @ifs && $ifs[$#ifs] < 0 && next;
+ if (/^$/) {
+ $empty && next;
+ $empty = 1;
+ } else { $empty = 0; }
+ }
+ print O;
+ }
+ close O;
+ close I;
+ ! -x $f or chmod(0755, "$dir/$f") or die "chmod($dir/$f): $!";
+ } else {
+ `cp -a $f $dir/$f`; die if $?;
+ }
+}
+
+sub GenPackage($) {
+ my ($s) = @_;
+ $s->{"PKG"} = $s->{"PACKAGE"} . "-" . $s->{"VERSION"};
+ my $dd = $s->{"DISTDIR"};
+ my $pkg = $s->{"PKG"};
+ my $dir = "$dd/$pkg";
+ print "Generating $dir\n";
+
+ FILES: foreach my $f (`find . -type f`) {
+ chomp $f;
+ $f =~ s/^\.\///;
+ my $action = "";
+ my @rules = @{$s->{"rules"}};
+ while (@rules) {
+ my $rule = shift @rules;
+ my $act = shift @rules;
+ if ($f =~ $rule) {
+ $action = $act;
+ last;
+ }
+ }
+ ($action =~ /-/) && next FILES;
+ print "$f ($action)\n" if $verbose;
+ $s->CopyFile($f, $dir, $action);
+ }
+
+ foreach my $d (@{$s->{"directories"}}) {
+ `mkdir -p $dir/$d`; die if $?;
+ }
+
+ if (-f "$dir/Makefile") {
+ print "Cleaning up\n";
+ `cd $dir && make distclean >&2`; die if $?;
+ }
+
+ print "Creating $dd/$pkg.tar.gz\n";
+ my $tarvv = $verbose ? "vv" : "";
+ `cd $dd && tar cz${tarvv}f $pkg.tar.gz $pkg >&2`; die if $?;
+ push @{$s->{"distfiles"}}, "$dd/$pkg.tar.gz";
+
+ my $adir = $s->{"archivedir"};
+ my $afile = "$adir/$pkg.tar.gz";
+ print "Archiving to $afile\n";
+ -d $adir or `mkdir -p $adir`;
+ `cp $dd/$pkg.tar.gz $afile`; die if $?;
+
+ return $dir;
+}
+
+sub GenFile($$) {
+ my ($s,$f) = @_;
+ my $sf = $s->{"DISTDIR"} . "/" . $s->{"PKG"} . "/$f";
+ my $df = $s->{"DISTDIR"} . "/$f";
+ print "Generating $df\n";
+ `cp $sf $df`; die if $?;
+ push @{$s->{"distfiles"}}, $df;
+}
+
+sub ParseOptions($) {
+ my ($s) = @_;
+ GetOptions(
+ "verbose!" => \$verbose,
+ "test!" => \$s->{"do_test"},
+ "patch!" => \$s->{"do_patch"},
+ "diff-against=s" => \$s->{"diff_against"},
+ "upload!" => \$s->{"do_upload"}
+ ) || die "Syntax: release [--verbose] [--test] [--nopatch] [--diff-against=<version>] [--noupload]";
+}
+
+sub Test($) {
+ my ($s) = @_;
+ my $dd = $s->{"DISTDIR"};
+ my $pkg = $s->{"PKG"};
+ my $log = "$dd/$pkg.log";
+ print "Doing a test compilation\n";
+ `( cd $dd/$pkg && make ) >$log 2>&1`;
+ die "There were errors. Please inspect $log" if $?;
+ `grep -q [Ww]arning $log`;
+ $? or print "There were warnings! Please inspect $log.\n";
+ print "Cleaning up\n";
+ `cd $dd/$pkg && make distclean`; die if $?;
+}
+
+sub MakePatch($) {
+ my ($s) = @_;
+ my $dd = $s->{"DISTDIR"};
+ my $pkg1 = $s->{"PKG"};
+ my $oldver;
+ if ($s->{"diff_against"} ne "") {
+ $oldver = $s->{"diff_against"};
+ } elsif (defined $s->{"OLDVERSION"}) {
+ $oldver = $s->{"OLDVERSION"};
+ } else {
+ print "WARNING: No previous version known. No patch generated.\n";
+ return;
+ }
+ my $pkg0 = $s->{"PACKAGE"} . "-" . $oldver;
+
+ my $oldarch = $s->{"archivedir"} . "/" . $pkg0 . ".tar.gz";
+ -f $oldarch or die "MakePatch: $oldarch not found";
+ print "Unpacking $pkg0 from $oldarch\n";
+ `cd $dd && tar xzf $oldarch`; die if $?;
+
+ my $diff = $s->{"PACKAGE"} . "-" . $oldver . "-" . $s->{"VERSION"} . ".diff.gz";
+ print "Creating a patch from $pkg0 to $pkg1: $diff\n";
+ `cd $dd && diff -ruN $pkg0 $pkg1 | gzip >$diff`; die if $?;
+ push @{$s->{"distfiles"}}, "$dd/$diff";
+}
+
+sub Upload($) {
+ my ($s) = @_;
+ foreach my $u (@{$s->{"uploads"}}) {
+ my $url = $u->{"url"};
+ print "Upload to $url :\n";
+ my @files = ();
+ my $filter = $u->{"filter"} || ".*";
+ foreach my $f (@{$s->{"distfiles"}}) {
+ if ($f =~ $filter) {
+ print "\t$f\n";
+ push @files, $f;
+ }
+ }
+ print "<confirm> "; <STDIN>;
+ if ($url =~ m@^scp://([^/]+)(.*)@) {
+ $, = " ";
+ my $host = $1;
+ my $dir = $2;
+ $dir =~ s@^/~@~@;
+ $dir =~ s@^/\./@@;
+ my $cmd = "scp @files $host:$dir\n";
+ `$cmd`; die if $?;
+ } elsif ($url =~ m@ftp://([^/]+)(.*)@) {
+ my $host = $1;
+ my $dir = $2;
+ open FTP, "|ftp -v $host" or die;
+ print FTP "cd $dir\n";
+ foreach my $f (@files) {
+ (my $ff = $f) =~ s@.*\/([^/].*)@$1@;
+ print FTP "put $f $ff\n";
+ }
+ print FTP "bye\n";
+ close FTP;
+ die if $?;
+ } else {
+ die "Don't know how to handle this URL scheme";
+ }
+ }
+}
+
+sub Dispatch($) {
+ my ($s) = @_;
+ $s->Test if $s->{"do_test"};
+ $s->MakePatch if $s->{"do_patch"};
+ $s->Upload if $s->{"do_upload"};
+}
+
+1;
projects / maildups.git / commitdiff