From eaae8b26daa2e99f96ff082d8bfb6574074211de Mon Sep 17 00:00:00 2001 From: Martin Mares Date: Sat, 21 Jan 2006 21:58:07 +0000 Subject: [PATCH] Released as 0.9. --- ChangeLog | 3 + Makefile | 2 +- README | 83 +++++++++++++ maint/release | 19 +++ maint/release.pm | 317 +++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 423 insertions(+), 1 deletion(-) create mode 100644 ChangeLog create mode 100644 README create mode 100755 maint/release create mode 100644 maint/release.pm diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..1856fcb --- /dev/null +++ b/ChangeLog @@ -0,0 +1,3 @@ +2006-01-21 Martin Mares + + * Released as version 0.9. diff --git a/Makefile b/Makefile index 6496a26..d19e610 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ #DEBUG=-ggdb CFLAGS=-O2 -Wall -W -Wno-parentheses -Wstrict-prototypes -Wmissing-prototypes -Winline $(DEBUG) -std=gnu99 -DVERSION=$(VERSION) -DYEAR=$(YEAR) -VERSION=0.1 +VERSION=0.9 YEAR=2006 all: mdup smail diff --git a/README b/README new file mode 100644 index 0000000..980b3f5 --- /dev/null +++ b/README @@ -0,0 +1,83 @@ +================================================================================ + + Duplicate Mail Checker @VERSION@ + + (c) 2006 Martin Mares + +================================================================================ + +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: , + 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: + +(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. diff --git a/maint/release b/maint/release new file mode 100755 index 0000000..a4150ad --- /dev/null +++ b/maint/release @@ -0,0 +1,19 @@ +#!/usr/bin/perl +# A simple script for making releases of maildups +# (c) 2006 Martin Mares + +use strict; +use warnings; +require "maint/release.pm"; + +my $r = new UCW::Release("maildups"); +$r->{'do_patch'} = 0; +my $ver = $r->GetVersionFromFile("Makefile", "^VERSION=(.*)"); +# $r->GetVersionsFromChangelog("ChangeLog", "Released as (.*)\."); +push @{$r->{"uploads"}}, { + "url" => "scp://atrey.karlin.mff.cuni.cz/~ftp/pub/local/mj/linux/" + }; +$r->ParseOptions; +$r->InitDist("maint/dist"); +my $reldir = $r->GenPackage; +$r->Dispatch; diff --git a/maint/release.pm b/maint/release.pm new file mode 100644 index 0000000..1e826c0 --- /dev/null +++ b/maint/release.pm @@ -0,0 +1,317 @@ +#!/usr/bin/perl +# A simple system for making software releases +# (c) 2003 Martin Mares + +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 () { + 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 () { + 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 () { + 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=] [--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 " "; ; + 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; -- 2.39.2