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