diff options
-rw-r--r-- | Changes | 84 | ||||
-rw-r--r-- | MANIFEST | 18 | ||||
-rw-r--r-- | MANIFEST.SKIP | 15 | ||||
-rw-r--r-- | META.json | 60 | ||||
-rw-r--r-- | META.yml | 37 | ||||
-rw-r--r-- | Makefile.PL | 171 | ||||
-rw-r--r-- | README | 96 | ||||
-rw-r--r-- | SIGNATURE | 40 | ||||
-rw-r--r-- | Todo | 34 | ||||
-rw-r--r-- | lib/CPAN/Checksums.pm | 432 | ||||
-rw-r--r-- | t/00signature.t | 92 | ||||
-rw-r--r-- | t/42.gz | bin | 0 -> 26 bytes | |||
-rw-r--r-- | t/43 | 1 | ||||
-rw-r--r-- | t/44.bz2 | bin | 0 -> 39 bytes | |||
-rw-r--r-- | t/52podcover.t | 14 | ||||
-rw-r--r-- | t/CHECKSUMS | 49 | ||||
-rw-r--r-- | t/pod.t | 6 | ||||
-rw-r--r-- | t/updatedir.t | 65 |
18 files changed, 1214 insertions, 0 deletions
@@ -0,0 +1,84 @@ +2015-04-11 k <andk@cpan.org> + + * Version 2.10; no functional change + + * 00signature.t: survive recent changes in ExtUtils::MakeMaker (_eumm) + and in Module::Signature ($ENV{TEST_SIGNATURE}) + + * add repository address to the Makefile.PL + + * add Changes file to the MANIFEST + +2014-04-04 k <andk@cpan.org> + + * Version 2.09; no functional change + + * improve test signature.t (Petr Písař) + +2011-08-30 Andreas J. Koenig <andk@cpan.org> + + * Version 2.08; no functional change + + * survive newest toolchain that creates a MYMETA.json + +2010-11-20 Andreas J. Koenig <andk@cpan.org> + + * Version 2.07; no functional change + + * survive the signature test under bad conditions + +2010-10-24 Andreas J. Koenig <andk@cpan.org> + + * Version 2.06 + + * add MYMETA.yml to MANIFEST.SKIP + +2010-01-23 Andreas J. Koenig <andk@cpan.org> + + * Version 2.05 + + * Addressing the test failure in + http://www.nntp.perl.org/group/perl.cpan.testers/2010/01/msg6705220.html + +2009-09-28 Andreas J. Koenig <andk@cpan.org> + + * Version 2.04 + + * Adding a signature verification test. The previous release had two + files missing. Signature verification would have notified me. + +2009-09-20 Andreas J. Koenig <andk@cpan.org> + + * Version 2.03 + + * Adding a Copyright statement. Up to now we only had a license but not + the copyright statement which makes it difficult for the reader to + understand the license. Thanks to Ryan Niebur for bringing this to my + attention. + +2008-10-31 Andreas J. Koenig <andreas.koenig.7os6VVqR@franz.ak.mind.de> + + * Version 2.02 + + * Bugfix: call binmode as a function and at the same time demand a newer + IO::File as prereq. (addressing + http://www.nntp.perl.org/group/perl.cpan.testers/2008/10/msg2516449.html) + +2008-09-03 Andreas J. Koenig <andreas.koenig.7os6VVqR@franz.ak.mind.de> + + * Version 2.01 + + * add missing binmode() for Windows (courtesy Elliot Shank) + +2008-05-17 Andreas J. Koenig <andreas.koenig.7os6VVqR@franz.ak.mind.de> + + * Version 2.00 + + * empty directories can now also get a checksums file. + + Local Variables: + mode: change-log + change-log-default-name: "Changes" + tab-width: 2 + left-margin: 2 + End: diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..8641e99 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,18 @@ +Changes +lib/CPAN/Checksums.pm +Makefile.PL +MANIFEST +MANIFEST.SKIP +META.yml +README +SIGNATURE +t/00signature.t +t/42.gz +t/43 +t/44.bz2 +t/52podcover.t +t/CHECKSUMS +t/pod.t +t/updatedir.t +Todo +META.json Module JSON meta-data (added by MakeMaker) diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..faecdc8 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,15 @@ +_eumm +MYMETA.(yml|json) +ChangeLog.old +DISTS +MANIFEST.bak +Makefile.old +^Makefile$ +\.lwpcookies +\.releaserc +\.svn/ +blib/ +pm_to_blib +~$ +\.tar\.gz$ +\.git diff --git a/META.json b/META.json new file mode 100644 index 0000000..36f5472 --- /dev/null +++ b/META.json @@ -0,0 +1,60 @@ +{ + "abstract" : "unknown", + "author" : [ + "unknown" + ], + "dynamic_config" : 1, + "generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.150001", + "keywords" : [ + "CPAN infrastructure", + "per-directory indexing and signing" + ], + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "CPAN-Checksums", + "no_index" : { + "directory" : [ + "t", + "inc" + ] + }, + "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "runtime" : { + "requires" : { + "Compress::Bzip2" : "0", + "Compress::Zlib" : "0", + "Data::Compare" : "0", + "Data::Dumper" : "0", + "Digest::MD5" : "2.36", + "Digest::SHA" : "0", + "DirHandle" : "0", + "File::Spec" : "0", + "File::Temp" : "0", + "IO::File" : "1.14", + "Module::Signature" : "0" + } + } + }, + "release_status" : "stable", + "resources" : { + "repository" : { + "url" : "git://github.com/andk/cpan-checksums.git" + } + }, + "version" : "2.10" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..09a9745 --- /dev/null +++ b/META.yml @@ -0,0 +1,37 @@ +--- +abstract: unknown +author: + - unknown +build_requires: + ExtUtils::MakeMaker: '0' +configure_requires: + ExtUtils::MakeMaker: '0' +dynamic_config: 1 +generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.150001' +keywords: + - 'CPAN infrastructure' + - 'per-directory indexing and signing' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: CPAN-Checksums +no_index: + directory: + - t + - inc +requires: + Compress::Bzip2: '0' + Compress::Zlib: '0' + Data::Compare: '0' + Data::Dumper: '0' + Digest::MD5: '2.36' + Digest::SHA: '0' + DirHandle: '0' + File::Spec: '0' + File::Temp: '0' + IO::File: '1.14' + Module::Signature: '0' +resources: + repository: git://github.com/andk/cpan-checksums.git +version: '2.10' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..94c51fa --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,171 @@ +#!/usr/bin/perl -w -*- mode: cperl -*- +use strict; +use ExtUtils::MakeMaker qw(:DEFAULT); +my $version_diff = 0; # we'll have to die if this becomes true +{ + my $version_from = q(lib/CPAN/Checksums.pm); + + { + local $^W; + $ExtUtils::MakeMaker::VERSION = eval $ExtUtils::MakeMaker::VERSION; + warn "Your MakeMaker is a bit dated[$ExtUtils::MakeMaker::VERSION].\nYou should get a new one\n" + if $ExtUtils::MakeMaker::VERSION < 6.0; + } + + if ($ARGV[0] && $ARGV[0] eq "--setversion") { + die "Your perl is a bit dated[$]].\nDo not make a release with it\n" if $] < 5.016; + die "Your MakeMaker is a bit dated[$ExtUtils::MakeMaker::VERSION].\nDo not make a release with it\n" + if $ExtUtils::MakeMaker::VERSION < 7; + die "Your MakeMaker doesn't do the sign woodoo" unless + MM->can("signature_target"); + shift @ARGV; + local $ENV{LANG} = "C"; + my $dirty = `git status --porcelain --untracked-files=no`; + die "Not everything checked in?" if $dirty; + + my $version_set_manually = 1; + if ($version_set_manually) { + # we must control that the VERSION in this .pm is the same as in the Makefile + unshift @INC, "lib"; + require $version_from; + open my $fh, "make the-release-name|" or die; + my $have_version; + while (<$fh>) { + next unless /^version\s+([\d\._]+)/; + $have_version = eval $1; + } + die "could not determine current version from Makefile" unless $have_version; + eval q{ + no warnings "numeric"; + if ($CPAN::Checksums::VERSION != $have_version) { + warn "Not equal: CPAN::Checksums::VERSION[$CPAN::Checksums::VERSION] Makefile version[$have_version]"; + $version_diff = 1; + } +}; + die $@ if $@; + } else { + die; + } + exit unless $version_diff; + } +} +my $prereq_pm = { + 'Compress::Bzip2' => 0, + 'Compress::Zlib' => 0, + 'Data::Compare' => 0, + 'Data::Dumper' => 0, + 'Digest::MD5' => "2.36", + 'Digest::SHA' => 0, + 'DirHandle' => 0, + 'File::Spec' => 0, + 'File::Temp' => 0, + 'IO::File' => "1.14", + }; +for my $interesting_module (qw( + Module::Signature + )) { + eval "require $interesting_module"; + if (!$@) { + $prereq_pm->{$interesting_module} ||= 0; + } +} + +WriteMakefile( + 'NAME' => 'CPAN::Checksums', + 'VERSION_FROM' => 'lib/CPAN/Checksums.pm', + (MM->can("signature_target") ? (SIGN => 1) : ()), + 'PREREQ_PM' => $prereq_pm, + ($ExtUtils::MakeMaker::VERSION >= 6.3002 ? + (LICENSE => "perl") : (), + ), + 'dist' => { + DIST_DEFAULT => join(" ", + "verify-changes-date", + "verify-changes-version", + 'Makefile', + "META.yml", + "setversion", + "README", + "all", + 'tardist', + ), + COMPRESS => 'gzip -9f' + }, + # I took it from RT-CPAN ticket 30098: + ($ExtUtils::MakeMaker::VERSION >= 6.4502 ? + (META_ADD => { + resources => { + repository => "git://github.com/andk/cpan-checksums.git", + }, + keywords => ['CPAN infrastructure','per-directory indexing and signing'], + }) : ()), + ); + +if ($version_diff){ + die " +==> I had to update some \$VERSIONs <== +==> Your Makefile has been rebuilt. <== +==> Please rerun the make command. <== +"; +} + +package MY; +sub postamble { + q{ +setversion: + $(PERL) Makefile.PL --setversion + +Makefile : lib/CPAN/Checksums.pm + +README: Makefile + $(PERL) -MPod::Text -e 'Pod::Text->new->parse_from_file(\*ARGV)' lib/CPAN/Checksums.pm > $@ + +the-release-name : + $(NOECHO) $(ECHO) 'version ' $(VERSION) + $(NOECHO) $(ECHO) 'release-name ' $(DISTVNAME).tar$(SUFFIX) + +release :: disttest + echo Once we are on git: git tag -m 'This is $(VERSION)' "$(VERSION)" + ls -l $(DISTVNAME).tar$(SUFFIX) + rm -rf $(DISTVNAME) + $(NOECHO) $(ECHO) ' lftp pause.perl.org' + $(NOECHO) $(ECHO) ' cd incoming' + $(NOECHO) $(ECHO) ' put $(DISTVNAME).tar$(SUFFIX)' + $(NOECHO) $(ECHO) ' quit' + $(NOECHO) $(ECHO) ' Once we are on git: git push --tags' + +sign: + `dirname $(PERL)`/cpansign -s + +META.yml: metafile + $(CP) $(DISTVNAME)/META.yml ./META.yml + +verify-changes-date: + @$(PERL) -ne 'BEGIN{my@t=(localtime)[5,4,3];$$t[0]+=1900;$$t[1]++;$$t=sprintf"%04d-%02d-%02d",@t}' \ + -e '$$ok++,exit if /^$$t\s/; END{die "Alert: did not find <$$t> in Changes file" unless $$ok}' Changes + +verify-changes-version: + @$(PERL) -ne '$$ok++,exit if /\b$(VERSION)\b/; END{die "Alert: did not find <$(VERSION)> in Changes file" unless $$ok}' Changes + +} +} + +sub dist_test { + return q{ +# if we depend on $(DISTVNAME).tar$(SUFFIX), then the rest of the +# Makefile breaks our intent to NOT remake dist +disttest : + rm -rf $(DISTVNAME) + tar xvzf $(DISTVNAME).tar$(SUFFIX) + cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL + cd $(DISTVNAME) && $(MAKE) $(PASTHRU) + cd $(DISTVNAME) && $(MAKE) test $(PASTHRU) + +} +} +sub distsignature { + my($self) = shift; + my $ret = $self->SUPER::distsignature_target(@_); + $ret =~ s|cpansign|\`dirname \$(PERL)\`/cpansign|g; + return $ret; +} @@ -0,0 +1,96 @@ +NAME + CPAN::Checksums - Write a "CHECKSUMS" file for a directory as on CPAN + +SYNOPSIS + use CPAN::Checksums qw(updatedir); + my $success = updatedir($directory); + +INCOMPATIBILITY ALERT + Since version 1.0 the generation of the attribute "shortname" is turned + off by default. It was too slow and was not used as far as I know, and + above all, it could fail on large directories. The shortname feature can + still be turned on by setting the global variable $TRY_SHORTNAME to a + true value. + +DESCRIPTION + $success = updatedir($dir) + "updatedir()" takes a directory name as argument and writes a typical + "CHECKSUMS" file in that directory as used on CPAN unless a previously + written "CHECKSUMS" file is there that is still valid. Returns 2 if a + new "CHECKSUMS" file has been written, 1 if a valid "CHECKSUMS" file + is already there, otherwise dies. + + Note: since version 2.0 updatedir on empty directories behaves just + the same. In older versions it silently did nothing. + + Global Variables in package CPAN::Checksums + $IGNORE_MATCH + If the global variable $IGNORE_MATCH is set, then all files matching + this expression will be completely ignored and will not be included + in the CPAN "CHECKSUMS" files. Per default this variable is set to + + qr{(?i-xsm:readme$)} + + $CAUTION + Setting the global variable $CAUTION causes updatedir() to report + changes of files in the attributes "size", "mtime", "md5", or + "md5-ungz" to STDERR. + + $TRY_SHORTNAME + By setting the global variable $TRY_SHORTNAME to a true value, you + can tell updatedir() to include an attribute "shortname" in the + resulting hash that is 8.3-compatible. Please note, that updatedir() + in this case may be slow and may even fail on large directories, + because it will always only try 1000 iterations to find a name that + is not yet taken and then give up. + + $SIGNING_KEY + Setting the global variable $SIGNING_KEY makes the generated + "CHECKSUMS" file to be clear-signed by the command specified in + $SIGNING_PROGRAM (defaults to "gpg --clearsign --default-key "), + passing the signing key as an extra argument. The resulting + "CHECKSUMS" file should look like: + + 0&&<<''; # this PGP-signed message is also valid perl + -----BEGIN PGP SIGNED MESSAGE----- + Hash: SHA1 + + # CHECKSUMS file written on ... by CPAN::Checksums (v...) + $cksum = { + ... + }; + + __END__ + -----BEGIN PGP SIGNATURE----- + ... + -----END PGP SIGNATURE----- + + note that the actual data remains intact, but two extra lines are + added to make it legal for both OpenPGP and perl syntax. + + $MIN_MTIME_CHECKSUMS + If the global variable $MIN_MTIME_CHECKSUMS is set, then updatedir + will renew signatures on checksum files that have an older mtime + than the given value. + +PREREQUISITES + DirHandle, IO::File, Digest::MD5, Digest::SHA, Compress::Bzip2, + Compress::Zlib, File::Spec, Data::Dumper, Data::Compare, File::Temp + +BUGS + If updatedir is interrupted, it may leave a temporary file lying around. + These files have the File::Temp template "CHECKSUMS.XXXX" and should be + harvested by a cronjob. + +AUTHOR + Andreas Koenig, andreas.koenig@anima.de; GnuPG support by Autrijus Tang + +COPYRIGHT & LICENSE + Copyright (c) 2002-2008 Andreas Koenig, Audrey Tang, Steve Peters. + + This program is free software; you can redistribute it and/or modify it + under the same terms as Perl itself. + +SEE ALSO + perl(1). + diff --git a/SIGNATURE b/SIGNATURE new file mode 100644 index 0000000..bd69374 --- /dev/null +++ b/SIGNATURE @@ -0,0 +1,40 @@ +This file contains message digests of all files listed in MANIFEST, +signed via the Module::Signature module, version 0.78. + +To verify the content in this distribution, first make sure you have +Module::Signature installed, then type: + + % cpansign -v + +It will check each file's integrity, as well as the signature's +validity. If "==> Signature verified OK! <==" is not displayed, +the distribution may already have been compromised, and you should +not run its Makefile.PL or Build.PL. + +-----BEGIN PGP SIGNED MESSAGE----- +Hash: SHA1 + +SHA1 1ac23788dccd16b7b0f3c9c11335e69970feabd5 Changes +SHA1 d27f105e01415961005f2007fb0a2e7e7989abdf MANIFEST +SHA1 e350d39b940e26c7b4319efa4fdb52199558cbcf MANIFEST.SKIP +SHA1 070cae446d5627987cdfb061ccef87f74d25ad69 META.json +SHA1 956aa45dcf5013d81c9e11880904940a887997d6 META.yml +SHA1 e0f8bfbb3328a0aaf672e29c3f3938ce5d2f9c2d Makefile.PL +SHA1 378ba4b97d5a989790877de0214ca23ac5aeef37 README +SHA1 b929ff9f01730419548cab2dfcc30003b49fbbfb Todo +SHA1 75aec0720bbd085f40bdeb79326e8a842f507fe3 lib/CPAN/Checksums.pm +SHA1 31b7160ffe51c46ef12d582edc06a63ea2e0ff1c t/00signature.t +SHA1 51e1c061bc02e9a38948a5d8e3ca7352830f0fac t/42.gz +SHA1 23e182506f4b883d8aae3d29d08e044c55b04deb t/43 +SHA1 0d942b3ef6791694fde4693d3329a0ff924cb583 t/44.bz2 +SHA1 57fa704d8f013fd117d9431b933932ae5c2f6a89 t/52podcover.t +SHA1 2d74a36030efca3a42026e2ceab6837c052e8a53 t/CHECKSUMS +SHA1 6a79f15a10337bd3450604abf39d4462df2a550b t/pod.t +SHA1 3a73818d40fce12a21bf9d4d2c38ee2145cc0628 t/updatedir.t +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1 + +iEYEARECAAYFAlUotUAACgkQ7IA58KMXwV01IQCgziu4d2RafNiK8DkSbipgeilt +CIoAn0B8mt3HtQL/0366AmT/bnfI31fo +=etjE +-----END PGP SIGNATURE----- @@ -0,0 +1,34 @@ +2009-09-20 Andreas J. Koenig <andk@cpan.org> + + * Ryan Niebur sent me a note that we have no copyright information in + the whole package. So although I have LICENSE stuff in the Makefile.PL, + the copyrigth escaped me somehow. How many other distros will have this + deficiency! + + "In Debian we need copyright/license information for all of the packages + we upload. Could you give us (replying to this email is fine): years of + copyright, copyright holders' names, copyright holders' e-mail + addresses. Unfortunately without this information we cannot upload it." + + That's only Audrey and Steve Peters and me. + +2005-12-11 Andreas Koenig <andk@cpan.org> + + * running updateddir on all 4012 checksummed directories on CPAN takes a + hell lot of time (over an hour) and slows other processes down, so I + wonder where the time is spent. If it were ungzip, we could lax our + interest to only computing it for files that have a new ungzip checksum + or so ($SKIP_UNGZ_IF_GZ_UNCHANGED or so). + + But if we can make sure that updatedir is always run after a change + (both upload and delete), we can run the whole find/update thing just + once a week. For now I have reduced it to every 6 hours so I can + investigate changes better. + + ######################################################################### + Local Variables: + mode: change-log + change-log-default-name: "Todo" + tab-width: 2 + left-margin: 2 + End: diff --git a/lib/CPAN/Checksums.pm b/lib/CPAN/Checksums.pm new file mode 100644 index 0000000..342e392 --- /dev/null +++ b/lib/CPAN/Checksums.pm @@ -0,0 +1,432 @@ +package CPAN::Checksums; + +use strict; +use vars qw( + $CAUTION + $DIRNAME + $IGNORE_MATCH + $MIN_MTIME_CHECKSUMS + $SIGNING_KEY + $SIGNING_PROGRAM + $TRY_SHORTNAME + $VERSION + @EXPORT_OK + @ISA + ); + +require Exporter; + +@ISA = qw(Exporter); +@EXPORT_OK = qw(updatedir); +$VERSION = "2.10"; +$VERSION =~ s/_//; +$CAUTION ||= 0; +$TRY_SHORTNAME ||= 0; +$SIGNING_PROGRAM ||= 'gpg --clearsign --default-key '; +$SIGNING_KEY ||= ''; +$MIN_MTIME_CHECKSUMS ||= 0; +$IGNORE_MATCH = qr{(?i-xsm:readme$)}; + +use DirHandle (); +use IO::File (); +use Digest::MD5 (); +use Compress::Bzip2(); +use Compress::Zlib (); +use File::Spec (); +use File::Temp; +use Data::Dumper (); +use Data::Compare (); +use Digest::SHA (); + +sub _dir_to_dref { + my($dirname,$old_dref) = @_; + my($dref) = {}; + my($dh)= DirHandle->new; + my($fh) = new IO::File; + $dh->open($dirname) or die "Couldn't opendir $dirname\: $!"; + my(%shortnameseen); + DIRENT: for my $de ($dh->read) { + next if $de =~ /^\./; + next if substr($de,0,9) eq "CHECKSUMS"; + next if $IGNORE_MATCH && $de =~ $IGNORE_MATCH; + + my $abs = File::Spec->catfile($dirname,$de); + + # + # SHORTNAME offers an 8.3 name, probably not needed but it was + # always there,,, + # + if ($TRY_SHORTNAME) { + my $shortname = lc $de; + $shortname =~ s/\.tar[._-]gz$/\.tgz/; + my $suffix; + ($suffix = $shortname) =~ s/.*\.//; + substr($suffix,3) = "" if length($suffix) > 3; + my @p; + if ($shortname =~ /\-/) { + @p = $shortname =~ /(.{1,16})-.*?([\d\.]{2,8})/; + } else { + @p = $shortname =~ /(.{1,8}).*?([\d\.]{2,8})/; + } + $p[0] ||= lc $de; + $p[0] =~ s/[^a-z0-9]//g; + $p[1] ||= 0; + $p[1] =~ s/\D//g; + my $counter = 7; + while (length($p[0]) + length($p[1]) > 8) { + substr($p[0], $counter) = "" if length($p[0]) > $counter; + substr($p[1], $counter) = "" if length($p[1]) > $counter--; + } + my $dot = $suffix ? "." : ""; + $shortname = "$p[0]$p[1]$dot$suffix"; + while (exists $shortnameseen{$shortname}) { + my($modi) = $shortname =~ /([a-z\d]+)/; + $modi++; + $shortname = "$modi$dot$suffix"; + if (++$counter > 1000){ # avoid endless loops and accept the buggy choice + warn "Warning: long loop on shortname[$shortname]de[$de]"; + last; + } + } + $dref->{$de}->{shortname} = $shortname; + $shortnameseen{$shortname} = undef; # for exists check good enough + } + + # + # STAT facts + # + if (-l File::Spec->catdir($dirname,$de)){ + # Symlinks are a mess on a replicated, database driven system, + # but as they are not forbidden, we cannot ignore them. We do + # have a directory with nothing but a symlink in it. When we + # ignored the symlink, we did not write a CHECKSUMS file and + # CPAN.pm issued lots of warnings:-( + $dref->{$de}{issymlink} = 1; + } + if (-d File::Spec->catdir($dirname,$de)){ + $dref->{$de}{isdir} = 1; + } else { + my @stat = stat $abs or next DIRENT; + $dref->{$de}{size} = $stat[7]; + my(@gmtime) = gmtime $stat[9]; + $gmtime[4]++; + $gmtime[5]+=1900; + $dref->{$de}{mtime} = sprintf "%04d-%02d-%02d", @gmtime[5,4,3]; + _add_digests($de,$dref,"Digest::SHA",[256],"sha256",$abs,$old_dref); + my $can_reuse_old_md5 = 1; + COMPARE: for my $param (qw(size mtime sha256)) { + if (!exists $old_dref->{$de}{$param} || + $dref->{$de}{$param} ne $old_dref->{$de}{$param}) { + $can_reuse_old_md5 = 0; + last COMPARE; + } + } + if ( $can_reuse_old_md5 ) { + for my $param (qw(md5 md5-ungz md5-unbz2)) { + next unless exists $old_dref->{$de}{$param}; + $dref->{$de}{$param} = $old_dref->{$de}{$param}; + } + } else { + _add_digests($de,$dref,"Digest::MD5",[],"md5",$abs,$old_dref); + } + + } # ! -d + } + $dh->close; + $dref; +} + +sub _read_old_ddump { + my($ckfn) = @_; + my $is_signed = 0; + my($fh) = new IO::File; + my $old_ddump = ""; + if ($fh->open($ckfn)) { + local $/ = "\n"; + while (<$fh>) { + next if /^\#/; + $is_signed = 1 if /SIGNED MESSAGE/; + $old_ddump .= $_; + } + close $fh; + } + return($old_ddump,$is_signed); +} + +sub updatedir ($) { + my($dirname) = @_; + my $ckfn = File::Spec->catfile($dirname, "CHECKSUMS"); # checksum-file-name + my($old_ddump,$is_signed) = _read_old_ddump($ckfn); + my($old_dref) = makehashref($old_ddump); + my $dref = _dir_to_dref($dirname,$old_dref); + local $Data::Dumper::Indent = 1; + local $Data::Dumper::Quotekeys = 1; + local $Data::Dumper::Sortkeys = 1; + my $ddump = Data::Dumper->new([$dref],["cksum"])->Dump; + my @ckfnstat = stat $ckfn; + if ($old_ddump) { + local $DIRNAME = $dirname; + if ( !!$SIGNING_KEY == !!$is_signed ) { # either both or neither + if (!$MIN_MTIME_CHECKSUMS || $ckfnstat[9] > $MIN_MTIME_CHECKSUMS ) { + # recent enough + return 1 if $old_ddump eq $ddump; + return 1 if ckcmp($old_dref,$dref); + } + } + if ($CAUTION) { + my $report = investigate($old_dref,$dref); + warn $report if $report; + } + } + my $ft = File::Temp->new( + DIR => $dirname, + TEMPLATE => "CHECKSUMS.XXXX", + CLEANUP => 0, + ) or die; + my $tckfn = $ft->filename; + close $ft; + my($fh) = new IO::File; + open $fh, ">$tckfn\0" or die "Couldn't open >$tckfn\: $!"; + + local $\; + if ($SIGNING_KEY) { + print $fh "0&&<<''; # this PGP-signed message is also valid perl\n"; + close $fh; + open $fh, "| $SIGNING_PROGRAM $SIGNING_KEY >> $tckfn" + or die "Could not call gpg: $!"; + $ddump .= "__END__\n"; + } + + my $message = sprintf "# CHECKSUMS file written on %s GMT by CPAN::Checksums (v%s)\n%s", + scalar gmtime, $VERSION, $ddump; + print $fh $message; + my $success = close $fh; + if ($SIGNING_KEY && !$success) { + warn "Couldn't run '$SIGNING_PROGRAM $SIGNING_KEY'! +Writing to $tckfn directly"; + open $fh, ">$tckfn\0" or die "Couldn't open >$tckfn\: $!"; + print $fh $message; + close $fh or warn "Couldn't close $tckfn: $!"; + } + chmod 0644, $ckfn or die "Couldn't chmod to 0644 for $ckfn\: $!" if -f $ckfn; + rename $tckfn, $ckfn or die "Could not rename: $!"; + chmod 0444, $ckfn or die "Couldn't chmod to 0444 for $ckfn\: $!"; + return 2; +} + +sub _add_digests ($$$$$$$) { + my($de,$dref,$module,$constructor_args,$keyname,$abs,$old_dref) = @_; + my($fh) = new IO::File; + my $dig = $module->new(@$constructor_args); + $fh->open("$abs\0") or die "Couldn't open $abs: $!"; + binmode($fh); # make sure it's called as a function, solaris with + # perl 5.8.4 complained about missing method in + # IO::File + $dig->addfile($fh); + $fh->close; + my $digest = $dig->hexdigest; + $dref->{$de}{$keyname} = $digest; + $dig = $module->new(@$constructor_args); + if ($de =~ /\.gz$/) { + my($buffer, $zip); + if (exists $old_dref->{$de}{$keyname} && + $dref->{$de}{$keyname} eq $old_dref->{$de}{$keyname} && + exists $old_dref->{$de}{"$keyname-ungz"} + ) { + $dref->{$de}{"$keyname-ungz"} = $old_dref->{$de}{"$keyname-ungz"}; + return; + } + if ($zip = Compress::Zlib::gzopen($abs, "rb")) { + $dig->add($buffer) + while $zip->gzread($buffer) > 0; + $dref->{$de}{"$keyname-ungz"} = $dig->hexdigest; + $zip->gzclose; + } + } elsif ($de =~ /\.bz2$/) { + my($buffer, $zip); + if (exists $old_dref->{$de}{$keyname} && + $dref->{$de}{$keyname} eq $old_dref->{$de}{$keyname} && + exists $old_dref->{$de}{"$keyname-unbz2"} + ) { + $dref->{$de}{"$keyname-unbz2"} = $old_dref->{$de}{"$keyname-unbz2"}; + return; + } + if ($zip = Compress::Bzip2::bzopen($abs, "rb")) { + $dig->add($buffer) + while $zip->bzread($buffer) > 0; + $dref->{$de}{"$keyname-unbz2"} = $dig->hexdigest; + $zip->bzclose; + } + } +} + +sub ckcmp ($$) { + my($old,$new) = @_; + for ($old,$new) { + $_ = makehashref($_); + } + Data::Compare::Compare($old,$new); +} + +# see if a file changed but the name not +sub investigate ($$) { + my($old,$new) = @_; + for ($old,$new) { + $_ = makehashref($_); + } + my $complain = ""; + for my $dist (sort keys %$new) { + if (exists $old->{$dist}) { + my $headersaid; + for my $diff (qw/md5 sha256 size md5-ungz sha256-ungz mtime/) { + next unless exists $old->{$dist}{$diff} && + exists $new->{$dist}{$diff}; + next if $old->{$dist}{$diff} eq $new->{$dist}{$diff}; + $complain .= + scalar gmtime(). + " GMT:\ndiffering old/new version of same file $dist:\n" + unless $headersaid++; + $complain .= + qq{\t$diff "$old->{$dist}{$diff}" -> "$new->{$dist}{$diff}"\n}; #}; + } + } + } + $complain; +} + +sub makehashref ($) { + local($_) = shift; + unless (ref $_ eq "HASH") { + require Safe; + my($comp) = Safe->new("CPAN::Checksums::reval"); + my $cksum; # used by Data::Dumper + $_ = $comp->reval($_) || {}; + die "CPAN::Checksums: Caught error[$@] while checking $DIRNAME" if $@; + } + $_; +} + +1; + +__END__ + +=head1 NAME + +CPAN::Checksums - Write a C<CHECKSUMS> file for a directory as on CPAN + +=head1 SYNOPSIS + + use CPAN::Checksums qw(updatedir); + my $success = updatedir($directory); + +=head1 INCOMPATIBILITY ALERT + +Since version 1.0 the generation of the attribute C<shortname> is +turned off by default. It was too slow and was not used as far as I +know, and above all, it could fail on large directories. The shortname +feature can still be turned on by setting the global variable +$TRY_SHORTNAME to a true value. + +=head1 DESCRIPTION + +=over 2 + +=item $success = updatedir($dir) + +C<updatedir()> takes a directory name as argument and writes a typical +C<CHECKSUMS> file in that directory as used on CPAN unless a previously +written C<CHECKSUMS> file is there that is still valid. Returns 2 if a +new C<CHECKSUMS> file has been written, 1 if a valid C<CHECKSUMS> file is +already there, otherwise dies. + +Note: since version 2.0 updatedir on empty directories behaves just +the same. In older versions it silently did nothing. + +=back + +=head2 Global Variables in package CPAN::Checksums + +=over + +=item $IGNORE_MATCH + +If the global variable $IGNORE_MATCH is set, then all files matching +this expression will be completely ignored and will not be included in +the CPAN C<CHECKSUMS> files. Per default this variable is set to + + qr{(?i-xsm:readme$)} + +=item $CAUTION + +Setting the global variable $CAUTION causes updatedir() to report +changes of files in the attributes C<size>, C<mtime>, C<md5>, or +C<md5-ungz> to STDERR. + +=item $TRY_SHORTNAME + +By setting the global variable $TRY_SHORTNAME to a true value, you can +tell updatedir() to include an attribute C<shortname> in the resulting +hash that is 8.3-compatible. Please note, that updatedir() in this +case may be slow and may even fail on large directories, because it +will always only try 1000 iterations to find a name that is not yet +taken and then give up. + +=item $SIGNING_KEY + +Setting the global variable $SIGNING_KEY makes the generated C<CHECKSUMS> +file to be clear-signed by the command specified in $SIGNING_PROGRAM +(defaults to C<gpg --clearsign --default-key >), passing the signing +key as an extra argument. The resulting C<CHECKSUMS> file should look like: + + 0&&<<''; # this PGP-signed message is also valid perl + -----BEGIN PGP SIGNED MESSAGE----- + Hash: SHA1 + + # CHECKSUMS file written on ... by CPAN::Checksums (v...) + $cksum = { + ... + }; + + __END__ + -----BEGIN PGP SIGNATURE----- + ... + -----END PGP SIGNATURE----- + +note that the actual data remains intact, but two extra lines are +added to make it legal for both OpenPGP and perl syntax. + +=item $MIN_MTIME_CHECKSUMS + +If the global variable $MIN_MTIME_CHECKSUMS is set, then updatedir +will renew signatures on checksum files that have an older mtime than +the given value. + +=back + +=head1 PREREQUISITES + +DirHandle, IO::File, Digest::MD5, Digest::SHA, Compress::Bzip2, +Compress::Zlib, File::Spec, Data::Dumper, Data::Compare, File::Temp + +=head1 BUGS + +If updatedir is interrupted, it may leave a temporary file lying +around. These files have the File::Temp template C<CHECKSUMS.XXXX> and +should be harvested by a cronjob. + +=head1 AUTHOR + +Andreas Koenig, andreas.koenig@anima.de; GnuPG support by Autrijus Tang + +=head1 COPYRIGHT & LICENSE + +Copyright (c) 2002-2008 Andreas Koenig, Audrey Tang, Steve Peters. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +perl(1). + +=cut diff --git a/t/00signature.t b/t/00signature.t new file mode 100644 index 0000000..35fc928 --- /dev/null +++ b/t/00signature.t @@ -0,0 +1,92 @@ +# -*- mode: cperl -*- + +use strict; +BEGIN { + sub find_exe { + my($exe,$path) = @_; + my($dir); + #warn "in find_exe exe[$exe] path[@$path]"; + for $dir (@$path) { + my $abs = File::Spec->catfile($dir,$exe); + require ExtUtils::MakeMaker; + if (($abs = MM->maybe_command($abs))) { + return $abs; + } + } + } + my $found_prereq = 0; + unless ($found_prereq) { + $found_prereq = eval { require Digest::SHA; 1 }; + } + unless ($found_prereq) { + $found_prereq = eval { require Digest::SHA1; 1 }; + } + unless ($found_prereq) { + $found_prereq = eval { require Digest::SHA::PurePerl; 1 }; + } + my $exit_message = ""; + unless ($found_prereq) { + $exit_message = "None of the supported SHA modules (Digest::SHA,Digest::SHA1,Digest::SHA::PurePerl) found"; + } + unless ($exit_message) { + if (!-f 'SIGNATURE') { + $exit_message = "No signature file"; + } + } + unless ($exit_message) { + if (!-s 'SIGNATURE') { + $exit_message = "Empty signature file"; + } + } + unless ($exit_message) { + if (eval { require Module::Signature; 1 }) { + my $min = "0.66"; + if ($Module::Signature::VERSION < $min-0.0000001) { + $exit_message = "Signature testing disabled for Module::Signature versions < $min"; + } + } else { + $exit_message = "No Module::Signature found [INC = @INC]"; + } + } + unless ($exit_message) { + if (!eval { + use Socket qw(AF_INET SOCK_STREAM pack_sockaddr_in inet_aton); + my $socket; + socket($socket, AF_INET, SOCK_STREAM, 0) and + connect( + $socket, + pack_sockaddr_in( + scalar getservbyname('hkp', 'tcp'), + inet_aton('pool.sks-keyservers.net') + ) + ) and + close($socket) + }) { + $exit_message = "Cannot connect to the keyserver"; + } + } + unless ($exit_message) { + require Config; + my(@path) = split /$Config::Config{'path_sep'}/, $ENV{'PATH'}; + if (!find_exe('gpg',\@path)) { + $exit_message = "Signature testing disabled without gpg program available"; + } + } + if ($exit_message) { + $|=1; + print "1..0 # SKIP $exit_message\n"; + eval "require POSIX; 1" and POSIX::_exit(0); + } +} + +print "1..1\n"; + +$ENV{TEST_SIGNATURE} = 1; +(Module::Signature::verify() == Module::Signature::SIGNATURE_OK()) + or print "not "; +print "ok 1 # Valid signature\n"; + +# Local Variables: +# mode: cperl +# cperl-indent-level: 4 +# End: Binary files differ@@ -0,0 +1 @@ +43 diff --git a/t/44.bz2 b/t/44.bz2 Binary files differnew file mode 100644 index 0000000..47e44fa --- /dev/null +++ b/t/44.bz2 diff --git a/t/52podcover.t b/t/52podcover.t new file mode 100644 index 0000000..48b82ff --- /dev/null +++ b/t/52podcover.t @@ -0,0 +1,14 @@ +# -*- mode: cperl -*- +use Test::More; +eval "use 5.00504"; +plan skip_all => "perl 5.00504 required for this test" if $@; +eval "use Test::Pod::Coverage 0.18"; # 0.15 was misbehaving according to David Cantrell +plan skip_all => "Test::Pod::Coverage 0.18 required for testing pod coverage" if $@; +plan tests => 1; +my $trustme = { trustme => [ qw{ + ckcmp + investigate + makehashref + }] + }; +pod_coverage_ok( "CPAN::Checksums", $trustme ); diff --git a/t/CHECKSUMS b/t/CHECKSUMS new file mode 100644 index 0000000..24b4b43 --- /dev/null +++ b/t/CHECKSUMS @@ -0,0 +1,49 @@ +# CHECKSUMS file written on Sat Nov 20 22:14:24 2010 GMT by CPAN::Checksums (v2.07) +$cksum = { + '00signature.t' => { + 'md5' => '55d2528e0129b0c32bc51bf287f2ac01', + 'mtime' => '2010-11-20', + 'sha256' => 'f429ad014eb27261603740854130e696bd106a087f0f92086b2862a3af6dcaf4', + 'size' => 2344 + }, + '42.gz' => { + 'md5' => '915cdde7181ab542763969e063b7a9a9', + 'md5-ungz' => '50a2fabfdd276f573ff97ace8b11c5f4', + 'mtime' => '2005-10-30', + 'sha256' => '787e758a975d04560f6a9d4671646a48c4e9da4f40d4e102bc4562cd15c71ab5', + 'sha256-ungz' => '084c799cd551dd1d8d5c5f9a5d593b2e931f5e36122ee5c793c1d08a19839cc0', + 'size' => 26 + }, + '43' => { + 'md5' => 'f0287f33eba7192e2a9c6a14f829aa1a', + 'mtime' => '2010-11-20', + 'sha256' => '0e55092af0746630c98d1b2e0d960617c33f8ea7b55739fd18cb7cd5342a28ca', + 'size' => 3 + }, + '44.bz2' => { + 'md5' => 'b3c551bfbf1d15ce93b47346a11cc87a', + 'md5-unbz2' => 'e760668b6273d38c832c153fde5725da', + 'mtime' => '2005-10-30', + 'sha256' => '09f646275a0b0622418ed364affe3c2df7dbb02c01862d84d7d06e6b6605c790', + 'sha256-unbz2' => 'b1ce0aa6fdf3cf349d773243dab9fbbe09d30619f38b0c1e8977e28c4f0bc495', + 'size' => 39 + }, + '52podcover.t' => { + 'md5' => '9845f6c5f049d637c92ae34e67328c77', + 'mtime' => '2007-08-05', + 'sha256' => '558d9083fe9dfa6aa66806caf4545bee35f2cac36592627aeed3b8cf0ca4fdf2', + 'size' => 567 + }, + 'pod.t' => { + 'md5' => '45b17e11a9736a0c485f861f95f063b9', + 'mtime' => '2005-12-15', + 'sha256' => '6109dadab614d170fc3db10b00a4c41c221860b1b1085a54af9a5f9f52480494', + 'size' => 152 + }, + 'updatedir.t' => { + 'md5' => 'b2dad83957b2786005860303866548c0', + 'mtime' => '2010-01-23', + 'sha256' => '583d24e7cbbf77a61b56ccced45b6f5b17844d0c8146f652fc92e2380ca63cc7', + 'size' => 1808 + } +}; @@ -0,0 +1,6 @@ +# -*- mode: cperl -*- + +use Test::More; +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; +all_pod_files_ok(); diff --git a/t/updatedir.t b/t/updatedir.t new file mode 100644 index 0000000..6ee0311 --- /dev/null +++ b/t/updatedir.t @@ -0,0 +1,65 @@ +# -*- Mode: cperl; cperl-indent-level: 4 -*- + +# Before `make install' is performed this script should be runnable with +# `make test'. + +use File::Path qw(mkpath rmtree); +use File::Spec; +use Test::More; +my $HAVE_TIME_HIRES = 0; + +sub _f ($) {File::Spec->catfile(split /\//, shift);} +sub _d ($) {File::Spec->catdir(split /\//, shift);} + +my $plan = 21; +if (eval { require Time::HiRes; 1; }) { + $HAVE_TIME_HIRES = 1; +} +plan tests => $plan; + +use_ok("CPAN::Checksums"); +my $ret = CPAN::Checksums::updatedir("t"); +ok($ret >= 1, "ret[$ret]"); + +my $warn; +{ + chmod 0644, _f"t/43"; + local *F; + open F, ">", _f"t/43" or die; + print F "4321\n" x 1_000_000; + close F; + local $CPAN::Checksums::CAUTION; + $CPAN::Checksums::CAUTION=1; + $SIG{__WARN__} = sub { $warn = shift; }; + $ret = CPAN::Checksums::updatedir("t"); + is($ret,2,"changed once"); + + like($warn,qr/^differing old\/new/m,"warning emitted"); + + my $start = $HAVE_TIME_HIRES ? Time::HiRes::time() : time; + $ret = CPAN::Checksums::updatedir("t"); + my $tooktime = ($HAVE_TIME_HIRES ? Time::HiRes::time() : time) - $start; + is($ret,1,"no change tooktime[$tooktime]"); + + open F, ">", _f"t/43"; + print F "43\n"; + close F; + $warn=""; +} + +$ret = CPAN::Checksums::updatedir("t"); +is($ret,2,"changed again"); +is($warn,"","no warning"); +my @stat = stat _f"t/CHECKSUMS"; +sleep 2; +$ret = CPAN::Checksums::updatedir("t"); +is($ret,1,"no change"); +my @stat2 = stat _f"t/CHECKSUMS"; +for my $s (0..7,9..11) { # 8==atime not our business; 12==blocks may magically change + is($stat[$s],$stat2[$s],"unchanged stat element $s"); +} +mkpath _d"t/emptydir"; +$ret = CPAN::Checksums::updatedir(_d"t/emptydir"); +is($ret,2,"empty dir gives also 2"); +ok(-f _f"t/emptydir/CHECKSUMS", "found the checksums file"); +rmtree _d"t/emptydir"; |