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;
54 print STDERR "$progname: $v: " . ($date || '?') . "\n"
59 open (my $in, '<', $changelog) || error ("$changelog: $!");
60 print STDERR "$progname: reading $changelog\n" if $verbose;
61 local $/ = undef; # read entire file
67 $body =~ s/^(\d+\.\d+[ \t])/\001$1/gm;
68 my @log = split (/\001/, $body);
70 foreach my $log (@log) {
71 my ($v1, $entry) = ($log =~ m/^(\d+\.\d+)\s+(.*)$/s);
73 $entry =~ s/^\s*\d\d?[- ][A-Z][a-z][a-z][- ]\d{4}:?\s+//s; # lose date
75 $entry =~ s/^\s+|\s+$//gs;
76 $entry =~ s/^\s+|\s+$//gm;
77 $entry =~ s/^[-*] /<BR>• /gm;
78 $entry =~ s/^<BR>//si;
81 my $v2 = $v1; $v2 =~ s/\.//gs;
84 foreach my $ext ('zip', 'dmg', 'tar.gz', 'tar.Z') {
85 foreach my $v ($v1, $v2) {
86 foreach my $name ($app_name, "x" . lc($app_name)) {
87 my $f = "$name-$v.$ext";
88 if (-f "$archive_dir/$f") {
96 my $url = ("${base_url}$app_name/" .
97 ($zip && -f "$www_dir/$zip" ? $zip : ""));
99 $url =~ s@DaliClock/@xdaliclock/@gs if $url; # Kludge
101 my @st = stat("$archive_dir/$zip") if $zip;
105 strftime ("%a, %d %b %Y %T %z", localtime($date))
108 my $odate = $dates{$v1};
109 my $sig = $sigs{$v1};
110 # Re-generate the sig if the file date changed.
111 $sig = undef if ($odate && $odate ne $date);
113 print STDERR "$progname: $v1: $date " . ($sig ? "Y" : "N") . "\n"
118 $ENV{PATH} = "/usr/bin:$ENV{PATH}";
119 $sig = `$sign_update "$archive_dir/$zip" "$priv_key_file"`;
123 my $enc = ($zip && -f "$www_dir/$zip"
124 ? ("<enclosure url=\"$url\"\n" .
125 " sparkle:version=\"$v1\"\n" .
126 " sparkle:dsaSignature=\"$sig\"\n" .
127 " length=\"$size\"\n" .
128 " type=\"application/octet-stream\" />\n")
129 : "<sparkle:version>$v1</sparkle:version>\n");
131 $enc =~ s/^/ /gm if $enc;
132 my $item = ("<item>\n" .
133 " <title>Version $v1</title>\n" .
134 " <link>$url</link>\n" .
135 " <description><![CDATA[$entry]]></description>\n" .
136 " <pubDate>$date</pubDate>\n" .
141 # I guess Sparkle doesn't like info-only items.
142 $item = '' unless ($zip && -f "$www_dir/$zip");
147 $rss = ("<?xml version=\"1.0\" encoding=\"utf-8\"?>\n" .
148 "<rss version=\"2.0\"\n" .
149 " xmlns:sparkle=\"http://www.andymatuschak.org/" .
150 "xml-namespaces/sparkle\"\n" .
151 " xmlns:dc=\"http://purl.org/dc/elements/1.1/\">\n" .
153 " <title>$app_name updater</title>\n" .
154 " <link>${base_url}$app_name/updates.xml</link>\n" .
155 " <description>Updates to $app_name.</description>\n" .
156 " <language>en</language>\n" .
161 if ($rss eq $obody) {
162 print STDERR "$progname: $outfile: unchanged\n";
164 my $tmp = "$outfile.tmp";
165 open (my $out, '>', $tmp) || error ("$tmp: $!");
169 system ("diff", "-wNU2", "$outfile", "$tmp");
172 if (!rename ("$tmp", "$outfile")) {
174 error ("mv $tmp $outfile: $!");
176 print STDERR "$progname: wrote $outfile\n";
185 print STDERR "$progname: $err\n";
190 print STDERR "usage: $progname [--verbose] app-name changelog archive www\n";
195 my ($app_name, $changelog, $archive_dir, $www_dir);
196 while ($#ARGV >= 0) {
198 if (m/^--?verbose$/) { $verbose++; }
199 elsif (m/^-v+$/) { $verbose += length($_)-1; }
200 elsif (m/^--?debug$/) { $debug_p++; }
201 elsif (m/^-./) { usage; }
202 elsif (!$app_name) { $app_name = $_; }
203 elsif (!$changelog) { $changelog = $_; }
204 elsif (!$archive_dir) { $archive_dir = $_; }
205 elsif (!$www_dir) { $www_dir = $_; }
209 usage unless $www_dir;
210 generate_xml ($app_name, $changelog, $archive_dir, $www_dir);