2 # Copyright © 2013 Jamie Zawinski <jwz@jwz.org>
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
12 # Generates updates.xml from README, archive/, and www/.
14 # Created: 27-Nov-2013.
20 use open ":encoding(utf8)";
23 my $progname = $0; $progname =~ s@.*/@@g;
24 my $version = q{ $Revision: 1.1 $ }; $version =~ s/^[^\d]+([\d.]+).*/$1/;
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";
34 sub generate_xml($$$$) {
35 my ($app_name, $changelog, $archive_dir, $www_dir) = @_;
37 my $outfile = "updates.xml";
42 if (open (my $in, '<', $outfile)) {
43 print STDERR "$progname: reading $outfile\n" if $verbose;
44 local $/ = undef; # read entire file
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);
52 $sigs{$v} = $sig if $sig;
53 $dates{$v} = $date if $date;
57 open (my $in, '<', $changelog) || error ("$changelog: $!");
58 print STDERR "$progname: reading $changelog\n" if $verbose;
59 local $/ = undef; # read entire file
65 $body =~ s/^(\d+\.\d+[ \t])/\001$1/gm;
66 my @log = split (/\001/, $body);
68 foreach my $log (@log) {
69 my ($v1, $entry) = ($log =~ m/^(\d+\.\d+)\s+(.*)$/s);
71 $entry =~ s/^\s*\d\d?[- ][A-Z][a-z][a-z][- ]\d{4}:?\s+//s; # lose date
73 $entry =~ s/^\s+|\s+$//gs;
74 $entry =~ s/^\s+|\s+$//gm;
75 $entry =~ s/^[-*] /<BR>• /gm;
76 $entry =~ s/^<BR>//si;
79 my $v2 = $v1; $v2 =~ s/\.//gs;
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") {
94 my $url = ("${base_url}$app_name/" .
95 ($zip && -f "$www_dir/$zip" ? $zip : ""));
97 $url =~ s@DaliClock/@xdaliclock/@gs if $url; # Kludge
99 my @st = stat("$archive_dir/$zip") if $zip;
103 strftime ("%a, %d %b %Y %T %z", localtime($date))
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);
113 $ENV{PATH} = "/usr/bin:$ENV{PATH}";
114 $sig = `$sign_update "$archive_dir/$zip" "$priv_key_file"`;
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");
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" .
136 # I guess Sparkle doesn't like info-only items.
137 $item = '' unless ($zip && -f "$www_dir/$zip");
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" .
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" .
156 if ($rss eq $obody) {
157 print STDERR "$progname: $outfile: unchanged\n";
159 my $tmp = "$outfile.tmp";
160 open (my $out, '>', $tmp) || error ("$tmp: $!");
164 system ("diff", "-wNU2", "$outfile", "$tmp");
167 if (!rename ("$tmp", "$outfile")) {
169 error ("mv $tmp $outfile: $!");
171 print STDERR "$progname: wrote $outfile\n";
180 print STDERR "$progname: $err\n";
185 print STDERR "usage: $progname [--verbose] app-name changelog archive www\n";
190 my ($app_name, $changelog, $archive_dir, $www_dir);
191 while ($#ARGV >= 0) {
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 = $_; }
204 usage unless $www_dir;
205 generate_xml ($app_name, $changelog, $archive_dir, $www_dir);