From http://www.jwz.org/xscreensaver/xscreensaver-5.35.tar.gz
[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) = ('$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;