git.hungrycats.org Git - xscreensaver/blob - OSX/updates.pl

   1 #!/usr/bin/perl -w
   2 # Copyright © 2013-2023 Jamie Zawinski <jwz@jwz.org>
   3 #
   4 # Permission to use, copy, modify, distribute, and sell this software and its
   5 # documentation for any purpose is hereby granted without fee, provided that
   6 # the above copyright notice appear in all copies and that both that
   7 # copyright notice and this permission notice appear in supporting
   8 # documentation.  No representations are made about the suitability of this
   9 # software for any purpose.  It is provided "as is" without express or
  10 # implied warranty.
  11 #
  12 # Generates updates.xml from README, archive/, and www/.
  13 #
  14 # Created: 27-Nov-2013.
  15
  16 require 5;
  17 use diagnostics;
  18 use strict;
  19
  20 use open ":encoding(utf8)";
  21 use POSIX;
  22
  23 my $progname = $0; $progname =~ s@.*/@@g;
  24 my ($version) = ('$Revision: 1.13 $' =~ m/\s(\d[.\d]+)\s/s);
  25
  26 my $verbose = 0;
  27 my $debug_p = 0;
  28
  29 my $base_url = "https://www.jwz.org/";
  30
  31
  32 # Sparkle used DSA signatures and began transitioning to EdDSA in version 1.21.
  33 # https://sparkle-project.org/documentation/eddsa-migration/
  34 #
  35 # For DSA keys, the XML file had "dsaSignature" attributes, Updater.plist
  36 # had a "SUPublicDSAKeyFile" key, and XScreenSaverUpdater.app contained
  37 # "Contents/Resources/sparkle_dsa_pub.pem".
  38 #
  39 # For EdDSA keys, the XML file has "edSignature", Updater.plist has a
  40 # "SUPublicEDKey" (with inline base64 data), and the PEM file is not used.
  41 #
  42 # Version history:
  43 #
  44 #   5.24 (Dec 2013) Sparkle 1.5b,   DSA key, first release with Sparkle
  45 #   5.41 (Dec 2018) Sparkle 1.21.2, DSA key
  46 #   6.02 (Oct 2011) Sparkle 1.27.0, DSA key
  47 #   6.03 (Feb 2022) Sparkle 1.27.0, DSA key and EdDSA key
  48 #   6.06 (Dec 2022) same
  49 #   6.07 (Aug 2023) Sparkle 1.27.0, EdDSA key only
  50 #
  51 # Once you ship an EdDSA-only version, users running releases that did not
  52 # contain EdDSA keys will not be able to auto-update, which in our case is
  53 # the 18 months between versions 6.03 and 6.07.  For Dali Clock, it was
  54 # 5 years between first EdDSA and dropping DSA:
  55 #
  56 #   2.40 (Nov 2013) Sparkle 1.5b,   DSA key, first release with Sparkle
  57 #   2.44 (Dec 2018) Sparkle 1.21.2, DSA key and EdDSA key
  58 #   2.48 (Aug 2023) Sparkle 1.27.0, EdDSA key only
  59
  60
  61 #my $dsa_priv_key_file = "$ENV{HOME}/.ssh/sparkle_dsa_priv.pem";
  62 #my $dsa_sign_update = "sparkle-bin/old_dsa_scripts/sign_update";
  63 my $edddsa_sign_update = "sparkle-bin/sign_update";
  64
  65
  66 sub generate_xml($$$$) {
  67   my ($app_name, $changelog, $archive_dir, $www_dir) = @_;
  68
  69   my $outfile = "updates.xml";
  70
  71   my $obody = '';
  72   my %sig1s;
  73   my %sig2s;
  74   my %dates;
  75   if (open (my $in, '<', $outfile)) {
  76     print STDERR "$progname: reading $outfile\n" if $verbose;
  77     local $/ = undef;  # read entire file
  78     $obody = <$in>;
  79     close $in;
  80     my @i = split (/<item/i, $obody);
  81     shift @i;
  82     foreach my $item (@i) {
  83       my ($v)    = ($item =~ m/version="(.*?)"/si);
  84 #     my ($sig1) = ($item =~ m/dsaSignature="(.*?)"/si);
  85       my ($sig2) = ($item =~ m/edSignature="(.*?)"/si);
  86       my ($date) = ($item =~ m/<pubDate>(.*?)</si);
  87       next unless $v;
  88 #     $sig1 = '' if (!defined($sig1) || $sig1 eq 'ERROR');
  89       $sig2 = '' if (!defined($sig2) || $sig2 eq 'ERROR');
  90 #     $sig1s{$v}  = $sig1 if $sig1;
  91       $sig2s{$v}  = $sig2 if $sig2;
  92       $dates{$v} = $date if $date;
  93       print STDERR "$progname: existing: $v: " . ($date || '?') . "\n"
  94         if ($verbose > 1);
  95     }
  96   }
  97
  98   open (my $in, '<', $changelog) || error ("$changelog: $!");
  99   print STDERR "$progname: reading $changelog\n" if $verbose;
 100   local $/ = undef;  # read entire file
 101   my $body = <$in>;
 102   close $in;
 103
 104   my $rss = "";
 105
 106   $body =~ s/^(\d+\.\d+(?:\.\d+)?[ \t])/\001$1/gm;
 107   my @log = split (/\001/, $body);
 108   shift @log;
 109   my $count = 0;
 110   foreach my $log (@log) {
 111     my ($v1, $entry) = ($log =~ m/^(\d+\.\d+(?:\.\d+)?)\s+(.*)$/s);
 112
 113     $entry =~ s/^\s*\d\d?[- ][A-Z][a-z][a-z][- ]\d{4}:?\s+//s;  # lose date
 114
 115     # unwrap continuation lines
 116     $entry =~ s/^[ \t]*[-*][ \t]+/\001/gm;
 117     $entry =~ s/\s+/ /gs;
 118     $entry =~ s/\001/\n* /gs;
 119     $entry =~ s/^\s+|\s+$//gm;
 120
 121     # Since this updater is only for macOS, omit any changelog entry
 122     # beginning with "X11:", "Android:" etc.
 123     $entry =~ s/^[-*] (X11|Android|Linux|iOS): [^\n]+(\n|$)//gm;
 124     $entry =~ s/^([-*] )macOS: /$1/gm;
 125
 126     $entry =~ s/^[-*] /<BR>&bull; /gm;
 127     $entry =~ s/^<BR>//si;
 128     $entry =~ s/\s+/ /gs;
 129
 130     my $v2 = $v1; $v2 =~ s/\.//gs;
 131     my $zip = undef;
 132   DONE:
 133     # It only makes sense to include entries in this file for releases for
 134     # which a DMG still exists. Expired releases and non-macOS releases
 135     # aren't helpful.
 136     #foreach my $ext ('zip', 'dmg', 'tar.gz', 'tar.Z') {
 137     foreach my $ext ('dmg') {
 138       foreach my $v ($v1, $v2) {
 139         next if ($app_name =~ m/xscreensaver/i
 140                  ? $v le '6.00'   # Skip the really old DMGs (5.14 PPC, etc.)
 141                  : $v le '243');
 142         foreach my $name ($app_name, "x" . lc($app_name)) {
 143           my $f = "$name-$v.$ext";
 144           if (-f "$archive_dir/$f") {
 145             $zip = $f;
 146             last DONE;
 147           }
 148         }
 149       }
 150     }
 151
 152     error ("no dmg for $v1") if (!$zip && $count == 0);
 153
 154     my $publishedp = ($zip && -f "$www_dir/$zip");
 155     $publishedp = 1 if ($count == 0);
 156
 157     my $url = ("${base_url}$app_name/" . ($publishedp && $zip ? $zip : ""));
 158
 159     $url =~ s@DaliClock/@xdaliclock/@gs if $url; # Kludge
 160
 161     my @st = stat("$archive_dir/$zip") if $zip;
 162     my $size = $st[7];
 163     my $date = $st[9];
 164     $date = ($date ?
 165              strftime ("%a, %d %b %Y %T %z", localtime($date))
 166              : "");
 167
 168     my $odate = $dates{$v1};
 169 #   my $sig1  = $sig1s{$v1};
 170     my $sig2  = $sig2s{$v1};
 171     # Re-generate the sig if the file date changed.
 172 #   $sig1 = undef if ($odate && $odate ne $date);
 173     $sig2 = undef if ($odate && $odate ne $date);
 174
 175     print STDERR "$progname: $v1: $date " .
 176 #                 ($sig1 ? "Y" : "N") .
 177                   ($sig2 ? "Y" : "N") .
 178                   "\n"
 179       if ($verbose > 1);
 180
 181 #    if (!$sig1 && $zip) {      # Old-style sigs
 182 #      local %ENV = %ENV;
 183 #      $ENV{PATH} = "/usr/bin:$ENV{PATH}";
 184 #      my $cmd = ("$dsa_sign_update" .
 185 #                 " \"$archive_dir/$zip\"" .
 186 #                 " \"$dsa_priv_key_file\"");
 187 #      print STDERR "$progname: exec: $cmd\n" if ($verbose > 1);
 188 #      $sig1 = `$cmd`;
 189 #      $sig1 =~ s/\s+//gs;
 190 #    }
 191
 192     if (!$sig2 && $zip) {       # New-style sigs
 193       local %ENV = %ENV;
 194       $ENV{PATH} = "/usr/bin:$ENV{PATH}";
 195       my $cmd = "$edddsa_sign_update \"$archive_dir/$zip\"";
 196       print STDERR "$progname: exec: $cmd\n" if ($verbose > 1);
 197       my $xml = `$cmd`;
 198       ($sig2) = ($xml =~ m/sparkle:edSignature=\"([^\"<>\s]+)\"/si);
 199       error ("unparsable: $edddsa_sign_update: $xml") unless $sig2;
 200     }
 201
 202 #   $sig1 = 'ERROR' unless defined($sig1);
 203     $sig2 = 'ERROR' unless defined($sig2);
 204     $size = -1 unless defined($size);
 205     my $enc = ($publishedp
 206                ? ("<enclosure url=\"$url\"\n" .
 207                   " sparkle:version=\"$v1\"\n" .
 208 #                 " sparkle:dsaSignature=\"$sig1\"\n" .
 209                   " sparkle:edSignature=\"$sig2\"\n" .
 210                   " length=\"$size\"\n" .
 211                   " type=\"application/octet-stream\" />\n")
 212                : "<sparkle:version>$v1</sparkle:version>\n");
 213
 214     $enc =~ s/^/ /gm if $enc;
 215     my $item = ("<item>\n" .
 216                 " <title>Version $v1</title>\n" .
 217                 " <link>$url</link>\n" .
 218                 " <description><![CDATA[$entry]]></description>\n" .
 219                 " <pubDate>$date</pubDate>\n" .
 220                 $enc .
 221                 "</item>\n");
 222     $item =~ s/^/  /gm;
 223
 224     # I guess Sparkle doesn't like info-only items.
 225     $item = '' unless $publishedp;
 226
 227     $rss .= $item;
 228     $count++;
 229   }
 230
 231   $rss = ("<?xml version=\"1.0\" encoding=\"utf-8\"?>\n" .
 232           "<rss version=\"2.0\"\n" .
 233           "     xmlns:sparkle=\"http://www.andymatuschak.org/" .
 234                "xml-namespaces/sparkle\"\n" .
 235           "     xmlns:dc=\"http://purl.org/dc/elements/1.1/\">\n" .
 236           " <channel>\n" .
 237           "  <title>$app_name updater</title>\n" .
 238           "  <link>${base_url}$app_name/updates.xml</link>\n" .
 239           "  <description>Updates to $app_name.</description>\n" .
 240           "  <language>en</language>\n" .
 241           $rss .
 242           " </channel>\n" .
 243           "</rss>\n");
 244
 245   if ($rss eq $obody) {
 246     print STDERR "$progname: $outfile: unchanged\n";
 247   } else {
 248     my $tmp = "$outfile.tmp";
 249     open (my $out, '>', $tmp) || error ("$tmp: $!");
 250     print $out $rss;
 251     close $out;
 252     if ($debug_p) {
 253       system ("diff", "-wNU2", "$outfile", "$tmp");
 254       unlink $tmp;
 255     } else {
 256       if (!rename ("$tmp", "$outfile")) {
 257         unlink "$tmp";
 258         error ("mv $tmp $outfile: $!");
 259       } else {
 260         print STDERR "$progname: wrote $outfile\n";
 261       }
 262     }
 263   }
 264 }
 265
 266
 267 sub error($) {
 268   my ($err) = @_;
 269   print STDERR "$progname: $err\n";
 270   exit 1;
 271 }
 272
 273 sub usage() {
 274   print STDERR "usage: $progname [--verbose] app-name changelog archive www\n";
 275   exit 1;
 276 }
 277
 278 sub main() {
 279   binmode (STDOUT, ':utf8');
 280   binmode (STDERR, ':utf8');
 281   my ($app_name, $changelog, $archive_dir, $www_dir);
 282   while ($#ARGV >= 0) {
 283     $_ = shift @ARGV;
 284     if (m/^--?verbose$/)  { $verbose++; }
 285     elsif (m/^-v+$/)      { $verbose += length($_)-1; }
 286     elsif (m/^--?debug$/) { $debug_p++; }
 287     elsif (m/^-./)        { usage; }
 288     elsif (!$app_name)    { $app_name = $_; }
 289     elsif (!$changelog)   { $changelog = $_; }
 290     elsif (!$archive_dir) { $archive_dir = $_; }
 291     elsif (!$www_dir)     { $www_dir = $_; }
 292     else { usage; }
 293   }
 294
 295   usage unless $www_dir;
 296   generate_xml ($app_name, $changelog, $archive_dir, $www_dir);
 297
 298 }
 299
 300 main();
 301 exit 0;