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

   1 #!/usr/bin/perl -w
   2 # Copyright © 2013 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.2 $' =~ 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 my $priv_key_file = "$ENV{HOME}/.ssh/sparkle_dsa_priv.pem";
  31 my $sign_update = "./sign_update.rb";
  32
  33
  34 sub generate_xml($$$$) {
  35   my ($app_name, $changelog, $archive_dir, $www_dir) = @_;
  36
  37   my $outfile = "updates.xml";
  38
  39   my $obody = '';
  40   my %sigs;
  41   my %dates;
  42   if (open (my $in, '<', $outfile)) {
  43     print STDERR "$progname: reading $outfile\n" if $verbose;
  44     local $/ = undef;  # read entire file
  45     $obody = <$in>;
  46     close $in;
  47     foreach my $item (split (/<item/i, $obody)) {
  48       my ($v)    = ($item =~ m/version="(.*?)"/si);
  49       my ($sig)  = ($item =~ m/dsaSignature="(.*?)"/si);
  50       my ($date) = ($item =~ m/<pubDate>(.*?)</si);
  51       next unless $v;
  52       $sigs{$v}  = $sig  if $sig;
  53       $dates{$v} = $date if $date;
  54       print STDERR "$progname: $v: " . ($date || '?') . "\n"
  55         if ($verbose > 1);
  56     }
  57   }
  58
  59   open (my $in, '<', $changelog) || error ("$changelog: $!");
  60   print STDERR "$progname: reading $changelog\n" if $verbose;
  61   local $/ = undef;  # read entire file
  62   my $body = <$in>;
  63   close $in;
  64
  65   my $rss = "";
  66
  67   $body =~ s/^(\d+\.\d+[ \t])/\001$1/gm;
  68   my @log = split (/\001/, $body);
  69   shift @log;
  70   my $count = 0;
  71   foreach my $log (@log) {
  72     my ($v1, $entry) = ($log =~ m/^(\d+\.\d+)\s+(.*)$/s);
  73
  74     $entry =~ s/^\s*\d\d?[- ][A-Z][a-z][a-z][- ]\d{4}:?\s+//s;  # lose date
  75
  76     $entry =~ s/^\s+|\s+$//gs;
  77     $entry =~ s/^\s+|\s+$//gm;
  78     $entry =~ s/^[-*] /<BR>&bull; /gm;
  79     $entry =~ s/^<BR>//si;
  80     $entry =~ s/\s+/ /gs;
  81
  82     my $v2 = $v1; $v2 =~ s/\.//gs;
  83     my $zip = undef;
  84   DONE:
  85     foreach my $ext ('zip', 'dmg', 'tar.gz', 'tar.Z') {
  86       foreach my $v ($v1, $v2) {
  87         foreach my $name ($app_name, "x" . lc($app_name)) {
  88           my $f = "$name-$v.$ext";
  89           if (-f "$archive_dir/$f") {
  90             $zip = $f;
  91             last DONE;
  92           }
  93         }
  94       }
  95     }
  96
  97     my $publishedp = ($zip && -f "$www_dir/$zip");
  98     $publishedp = 1 if ($count == 0);
  99
 100     my $url = ("${base_url}$app_name/" . ($publishedp ? $zip : ""));
 101
 102     $url =~ s@DaliClock/@xdaliclock/@gs if $url; # Kludge
 103
 104     my @st = stat("$archive_dir/$zip") if $zip;
 105     my $size = $st[7];
 106     my $date = $st[9];
 107     $date = ($zip ?
 108              strftime ("%a, %d %b %Y %T %z", localtime($date))
 109              : "");
 110
 111     my $odate = $dates{$v1};
 112     my $sig   = $sigs{$v1};
 113     # Re-generate the sig if the file date changed.
 114     $sig = undef if ($odate && $odate ne $date);
 115
 116     print STDERR "$progname: $v1: $date " . ($sig ? "Y" : "N") . "\n"
 117       if ($verbose > 1);
 118
 119     if (!$sig && $zip) {
 120       local %ENV = %ENV;
 121       $ENV{PATH} = "/usr/bin:$ENV{PATH}";
 122       $sig = `$sign_update "$archive_dir/$zip" "$priv_key_file"`;
 123       $sig =~ s/\s+//gs;
 124     }
 125
 126     my $enc = ($publishedp
 127                ? ("<enclosure url=\"$url\"\n" .
 128                   " sparkle:version=\"$v1\"\n" .
 129                   " sparkle:dsaSignature=\"$sig\"\n" .
 130                   " length=\"$size\"\n" .
 131                   " type=\"application/octet-stream\" />\n")
 132                : "<sparkle:version>$v1</sparkle:version>\n");
 133
 134     $enc =~ s/^/ /gm if $enc;
 135     my $item = ("<item>\n" .
 136                 " <title>Version $v1</title>\n" .
 137                 " <link>$url</link>\n" .
 138                 " <description><![CDATA[$entry]]></description>\n" .
 139                 " <pubDate>$date</pubDate>\n" .
 140                 $enc .
 141                 "</item>\n");
 142     $item =~ s/^/  /gm;
 143
 144     # I guess Sparkle doesn't like info-only items.
 145     $item = '' unless $publishedp;
 146
 147     $rss .= $item;
 148     $count++;
 149   }
 150
 151   $rss = ("<?xml version=\"1.0\" encoding=\"utf-8\"?>\n" .
 152           "<rss version=\"2.0\"\n" .
 153           "     xmlns:sparkle=\"http://www.andymatuschak.org/" .
 154                "xml-namespaces/sparkle\"\n" .
 155           "     xmlns:dc=\"http://purl.org/dc/elements/1.1/\">\n" .
 156           " <channel>\n" .
 157           "  <title>$app_name updater</title>\n" .
 158           "  <link>${base_url}$app_name/updates.xml</link>\n" .
 159           "  <description>Updates to $app_name.</description>\n" .
 160           "  <language>en</language>\n" .
 161           $rss .
 162           " </channel>\n" .
 163           "</rss>\n");
 164
 165   if ($rss eq $obody) {
 166     print STDERR "$progname: $outfile: unchanged\n";
 167   } else {
 168     my $tmp = "$outfile.tmp";
 169     open (my $out, '>', $tmp) || error ("$tmp: $!");
 170     print $out $rss;
 171     close $out;
 172     if ($debug_p) {
 173       system ("diff", "-wNU2", "$outfile", "$tmp");
 174       unlink $tmp;
 175     } else {
 176       if (!rename ("$tmp", "$outfile")) {
 177         unlink "$tmp";
 178         error ("mv $tmp $outfile: $!");
 179       } else {
 180         print STDERR "$progname: wrote $outfile\n";
 181       }
 182     }
 183   }
 184 }
 185
 186
 187 sub error($) {
 188   my ($err) = @_;
 189   print STDERR "$progname: $err\n";
 190   exit 1;
 191 }
 192
 193 sub usage() {
 194   print STDERR "usage: $progname [--verbose] app-name changelog archive www\n";
 195   exit 1;
 196 }
 197
 198 sub main() {
 199   my ($app_name, $changelog, $archive_dir, $www_dir);
 200   while ($#ARGV >= 0) {
 201     $_ = shift @ARGV;
 202     if (m/^--?verbose$/)  { $verbose++; }
 203     elsif (m/^-v+$/)      { $verbose += length($_)-1; }
 204     elsif (m/^--?debug$/) { $debug_p++; }
 205     elsif (m/^-./)        { usage; }
 206     elsif (!$app_name)    { $app_name = $_; }
 207     elsif (!$changelog)   { $changelog = $_; }
 208     elsif (!$archive_dir) { $archive_dir = $_; }
 209     elsif (!$www_dir)     { $www_dir = $_; }
 210     else { usage; }
 211   }
 212
 213   usage unless $www_dir;
 214   generate_xml ($app_name, $changelog, $archive_dir, $www_dir);
 215
 216 }
 217
 218 main();
 219 exit 0;