release.pl

   1 #!/usr/bin/perl
   2
   3 # Script to automate some easy-to-mess-up parts of the PuTTY release
   4 # procedure.
   5
   6 use strict;
   7 use warnings;
   8 use Getopt::Long;
   9 use File::Find;
  10 use File::Temp qw/tempdir/;
  11 use LWP::UserAgent;
  12
  13 my $version = undef;
  14 my $setver = 0;
  15 my $upload = 0;
  16 my $precheck = 0;
  17 my $postcheck = 0;
  18 GetOptions("version=s" => \$version,
  19            "setver" => \$setver,
  20            "upload" => \$upload,
  21            "precheck" => \$precheck,
  22            "postcheck" => \$postcheck)
  23     or &usage();
  24
  25 # --set-version: construct a local commit which updates the version
  26 # number, and the command-line help transcripts in the docs.
  27 if ($setver) {
  28     defined $version or die "use --version";
  29     0 == system "git", "diff-index", "--quiet", "--cached", "HEAD"
  30         or die "index is dirty";
  31     0 == system "git", "diff-files", "--quiet" or die "working tree is dirty";
  32     -f "Makefile" and die "run 'make distclean' first";
  33     my $builddir = tempdir(DIR => ".", CLEANUP => 1);
  34     0 == system "./mkfiles.pl" or die;
  35     0 == system "cd $builddir && ../configure" or die;
  36     0 == system "cd $builddir && make pscp plink RELEASE=${version}" or die;
  37     our $pscp_transcript = `cd $builddir && ./pscp --help`;
  38     $pscp_transcript =~ s/^Unidentified build/Release ${version}/m or die;
  39     $pscp_transcript =~ s/^/\\c /mg;
  40     our $plink_transcript = `cd $builddir && ./plink --help`;
  41     $plink_transcript =~ s/^Unidentified build/Release ${version}/m or die;
  42     $plink_transcript =~ s/^/\\c /mg;
  43     &transform("LATEST.VER", sub { s/^\d+\.\d+$/$version/ });
  44     &transform("windows/putty.iss", sub {
  45         s/^(AppVerName=PuTTY version |VersionInfoTextVersion=Release |AppVersion=|VersionInfoVersion=)\d+\.\d+/$1$version/ });
  46     our $transforming = 0;
  47     &transform("doc/pscp.but", sub {
  48         if (/^\\c.*>pscp$/) { $transforming = 1; $_ .= $pscp_transcript; }
  49         elsif (!/^\\c/) { $transforming = 0; }
  50         elsif ($transforming) { $_=""; }
  51     });
  52     $transforming = 0;
  53     &transform("doc/plink.but", sub {
  54         if (/^\\c.*>plink$/) { $transforming = 1; $_ .= $plink_transcript; }
  55         elsif (!/^\\c/) { $transforming = 0; }
  56         elsif ($transforming) { $_=""; }
  57     });
  58     &transform("Buildscr", sub {
  59         s!^(set Epoch )\d+!$1 . sprintf "%d", time/86400 - 1000!e });
  60     0 == system ("git", "commit", "-a", "-m",
  61                  "Update version number for ${version} release.") or die;
  62     exit 0;
  63 }
  64
  65 # --upload: upload the release to all the places it should live, and
  66 # check all signatures and md5sums once it arrives there.
  67 if ($upload) {
  68     defined $version or die "use --version";
  69
  70     # Run this inside the build.out directory.
  71     -d "maps" or die "no maps directory in cwd";
  72     -d "putty" or die "no putty directory in cwd";
  73
  74     0 == system("rsync", "-av", "maps/",
  75                 "thyestes:src/putty-local/maps-$version")
  76         or die "could not upload link maps";
  77
  78     for my $location (["thyestes", "www/putty/$version"],
  79                       ["the",      "www/putty/$version"],
  80                       ["chiark",   "ftp/putty-$version"]) {
  81         my ($host, $path) = @$location;
  82         0 == system("rsync", "-av", "putty/", "$host:$path")
  83             or die "could not upload release to $host";
  84         open my $pipe, "|-", "ssh", $host, "cd $path && sh";
  85         print $pipe "set -e\n";
  86         print $pipe "pwd\n";
  87         find({ wanted => sub
  88                {
  89                    if (m!^putty/(.*).gpg!) {
  90                        my $file = $1;
  91                        print $pipe "echo verifying $file\n";
  92                        if ($file =~ /sums$/) {
  93                            print $pipe "gpg --verify $file.gpg\n";
  94                        } else {
  95                            print $pipe "gpg --verify $file.gpg $file\n";
  96                        }
  97                    } elsif (m!^putty/(.*sum)s!) {
  98                        print $pipe "echo checking ${1}s\n";
  99                        print $pipe "$1 -c ${1}s\n";
 100                    }
 101                }, no_chdir => 1}, "putty");
 102         print $pipe "echo all verified ok\n";
 103         close $pipe;
 104         die "VERIFICATION FAILED on $host" if $? != 0;
 105     }
 106
 107     print "Uploaded $version OK!\n";
 108     exit 0;
 109 }
 110
 111 # --precheck and --postcheck: attempt to download the release from its
 112 # various web and FTP locations.
 113 if ($precheck || $postcheck) {
 114     defined $version or die "use --version";
 115
 116     # Run this inside the build.out directory, so we can check the
 117     # downloaded files against the exact contents they should have.
 118     -d "putty" or die "no putty directory in cwd";
 119
 120     my $httpprefix = "https://the.earth.li/~sgtatham/putty/";
 121     my $ftpprefix = "ftp://ftp.chiark.greenend.org.uk/users/sgtatham/putty-";
 122
 123     # Go through all the files in build.out.
 124     find({ wanted => sub
 125            {
 126                if (-f $_) {
 127                    die unless (m!^putty/(.*)$!);
 128                    my $path = $1;
 129
 130                    # Don't try to check .htaccess - web servers will
 131                    # treat it weirdly.
 132                    return if $path =~ m!^(.*/)?.htaccess$!;
 133
 134                    print "Checking $path\n";
 135
 136                    my $real_content = "";
 137                    open my $fh, "<", $_ or die "$_: open local file: $!";
 138                    $real_content .= $_ while <$fh>;
 139                    close $fh;
 140
 141                    my $http_numbered = "${httpprefix}$version/$path";
 142                    my $http_latest   = "${httpprefix}latest/$path";
 143                    my $ftp_numbered  = "${ftpprefix}$version/$path";
 144                    my $ftp_latest    = "${ftpprefix}latest/$path";
 145
 146                    my ($http_uri, $ftp_uri);
 147
 148                    if ($precheck) {
 149                        # Before the 'latest' links/redirects update,
 150                        # we just download from explicitly version-
 151                        # numbered URLs.
 152                        $http_uri = $http_numbered;
 153                        $ftp_uri = $ftp_numbered;
 154                    }
 155                    if ($postcheck) {
 156                        # After 'latest' is updated, we're testing that
 157                        # the redirects work, so we download from the
 158                        # URLs with 'latest' in them.
 159                        $http_uri = $http_latest;
 160                        $ftp_uri = $ftp_latest;
 161                    }
 162
 163                    # Now test-download the files themselves.
 164                    my $ftpdata = `curl -s $ftp_uri`;
 165                    printf "  got %d bytes via FTP", length $ftpdata;
 166                    die "FTP download for $ftp_uri did not match"
 167                        if $ftpdata ne $real_content;
 168                    print ", ok\n";
 169
 170                    my $ua = LWP::UserAgent->new;
 171                    my $httpresponse = $ua->get($http_uri);
 172                    my $httpdata = $httpresponse->{_content};
 173                    printf "  got %d bytes via HTTP", length $httpdata;
 174                    die "HTTP download for $http_uri did not match"
 175                        if $httpdata ne $real_content;
 176                    print ", ok\n";
 177
 178                    # Check content types on any files likely to go
 179                    # wrong.
 180                    my $ct = $httpresponse->{_headers}->{"content-type"};
 181                    if (defined $ct) {
 182                        printf "  got content-type %s", $ct;
 183                    } else {
 184                        printf "  got no content-type";
 185                    }
 186                    my $right_ct = undef;
 187                    if ($path =~ m/\.(hlp|cnt|chm)$/) {
 188                        $right_ct = "application/octet-stream";
 189                    } elsif ($path =~ /\.gpg$/) {
 190                        $right_ct = "application/pgp-signature";
 191                    }
 192                    if (defined $right_ct) {
 193                        if ($ct ne $right_ct) {
 194                            die "content-type $ct should be $right_ct";
 195                        } else {
 196                            print ", ok\n";
 197                        }
 198                    } else {
 199                        print "\n";
 200                    }
 201
 202                    if ($postcheck) {
 203                        # Finally, if we're testing the 'latest' URL,
 204                        # also check that the HTTP redirect header was
 205                        # present and correct.
 206                        my $redirected = $httpresponse->{_request}->{_uri};
 207                        printf "  redirect -> %s\n", $redirected;
 208                        die "redirect header wrong for $http_uri"
 209                            if $redirected ne $http_numbered;
 210                    }
 211                }
 212            }, no_chdir => 1}, "putty");
 213
 214     print "Check OK\n";
 215     exit 0;
 216 }
 217
 218 &usage();
 219
 220 sub transform {
 221     my ($filename, $proc) = @_;
 222     my $file;
 223     open $file, "<", $filename or die "$file: open for read: $!\n";
 224     my $data = "";
 225     while (<$file>) {
 226         $proc->();
 227         $data .= $_;
 228     }
 229     close $file;
 230     open $file, ">", $filename or die "$file: open for write: $!\n";
 231     print $file $data;
 232     close $file or die "$file: close after write: $!\n";;
 233 }
 234
 235 sub usage {
 236     die "usage: release.pl --set-version=X.YZ\n";
 237 }