From 26d8d4d1d2a7a8ebcffc6ff5c6b13495f74dd129 Mon Sep 17 00:00:00 2001 From: Lorry Tar Creator Date: Sat, 11 Apr 2015 05:46:40 +0000 Subject: CPAN-Checksums-2.10 --- Changes | 84 ++++++++++ MANIFEST | 18 +++ MANIFEST.SKIP | 15 ++ META.json | 60 +++++++ META.yml | 37 +++++ Makefile.PL | 171 ++++++++++++++++++++ README | 96 +++++++++++ SIGNATURE | 40 +++++ Todo | 34 ++++ lib/CPAN/Checksums.pm | 432 ++++++++++++++++++++++++++++++++++++++++++++++++++ t/00signature.t | 92 +++++++++++ t/42.gz | Bin 0 -> 26 bytes t/43 | 1 + t/44.bz2 | Bin 0 -> 39 bytes t/52podcover.t | 14 ++ t/CHECKSUMS | 49 ++++++ t/pod.t | 6 + t/updatedir.t | 65 ++++++++ 18 files changed, 1214 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 MANIFEST.SKIP create mode 100644 META.json create mode 100644 META.yml create mode 100644 Makefile.PL create mode 100644 README create mode 100644 SIGNATURE create mode 100644 Todo create mode 100644 lib/CPAN/Checksums.pm create mode 100644 t/00signature.t create mode 100644 t/42.gz create mode 100644 t/43 create mode 100644 t/44.bz2 create mode 100644 t/52podcover.t create mode 100644 t/CHECKSUMS create mode 100644 t/pod.t create mode 100644 t/updatedir.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..3759763 --- /dev/null +++ b/Changes @@ -0,0 +1,84 @@ +2015-04-11 k + + * 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 + + * Version 2.09; no functional change + + * improve test signature.t (Petr Písař) + +2011-08-30 Andreas J. Koenig + + * Version 2.08; no functional change + + * survive newest toolchain that creates a MYMETA.json + +2010-11-20 Andreas J. Koenig + + * Version 2.07; no functional change + + * survive the signature test under bad conditions + +2010-10-24 Andreas J. Koenig + + * Version 2.06 + + * add MYMETA.yml to MANIFEST.SKIP + +2010-01-23 Andreas J. Koenig + + * 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 + + * 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 + + * 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 + + * 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 + + * Version 2.01 + + * add missing binmode() for Windows (courtesy Elliot Shank) + +2008-05-17 Andreas J. Koenig + + * 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; +} diff --git a/README b/README new file mode 100644 index 0000000..c66a033 --- /dev/null +++ b/README @@ -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----- diff --git a/Todo b/Todo new file mode 100644 index 0000000..862deac --- /dev/null +++ b/Todo @@ -0,0 +1,34 @@ +2009-09-20 Andreas J. Koenig + + * 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 + + * 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 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 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 takes a directory name as argument and writes a typical +C file in that directory as used on CPAN unless a previously +written C file is there that is still valid. Returns 2 if a +new C file has been written, 1 if a valid C 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 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, C, C, or +C 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 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 +file to be clear-signed by the command specified in $SIGNING_PROGRAM +(defaults to C), passing the signing +key as an extra argument. The resulting C 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 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: diff --git a/t/42.gz b/t/42.gz new file mode 100644 index 0000000..eeb3e52 Binary files /dev/null and b/t/42.gz differ diff --git a/t/43 b/t/43 new file mode 100644 index 0000000..920a139 --- /dev/null +++ b/t/43 @@ -0,0 +1 @@ +43 diff --git a/t/44.bz2 b/t/44.bz2 new file mode 100644 index 0000000..47e44fa Binary files /dev/null and b/t/44.bz2 differ 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 + } +}; diff --git a/t/pod.t b/t/pod.t new file mode 100644 index 0000000..105953b --- /dev/null +++ b/t/pod.t @@ -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"; -- cgit v1.2.1