developer-manual: Add more build instructions for Debian
[privoxy.git] / utils / create-package-feed.pl
1 #!/usr/local/bin/perl
2
3 ############################################################################
4 # create-package-feed.pl
5 #
6 # Generates an RSS feed for the released files.
7 #
8 # Usage:
9 # create-package-feed.pl "path/to/release/files" "path/to/rss/outputfile"
10 #
11 # Copyright (c) 2016 "Unknown", Fabian Keil <fk@fabiankeil.de>
12 #
13 # Permission to use, copy, modify, and distribute this software for any
14 # purpose with or without fee is hereby granted, provided that the above
15 # copyright notice and this permission notice appear in all copies.
16 #
17 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
18 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
19 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
20 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
21 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
22 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
23 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
24 ############################################################################
25
26 use warnings;
27 use strict;
28 use Digest::SHA;
29 my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
30 my @days   = qw(Sun Mon Tue Wed Thu Fri Sat Sun);
31
32 my $base_dlurl = 'https://www.privoxy.org/sf-download-mirror/';
33 my $max_advertised_files = 100;
34
35 sub generate_rss_item($$$$) {
36     my ($target, $target_uri, $target_time, $target_sha256) = @_;
37
38     my $rss_item;
39     my $escaped_target_uri = $target_uri;
40     $escaped_target_uri =~ s@ @%20@g;
41
42     # RSS line
43     $rss_item =
44         '<item><title><![CDATA[' . $target_uri . ']]></title>';
45     $rss_item .=
46         '<description><![CDATA['
47         . $target_uri
48         . ' (SHA-256: '
49         . $target_sha256
50         . ')]]></description>';
51     $rss_item .=
52         '<link>'
53         . $base_dlurl
54         . $escaped_target_uri
55         . '</link><guid>'
56         . $base_dlurl
57         . $escaped_target_uri
58         . '</guid>';
59     $rss_item .= '<pubDate>';
60     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
61         gmtime($target_time);
62     $rss_item .= sprintf("%s, %s %s %d %.2d:%.2d:%.2d GMT",
63                          $days[$wday], $mday, $months[$mon], ($year + 1900),
64                          $hour, $min, $sec);
65     $rss_item .= '</pubDate></item>';
66     $rss_item .= "\n";
67
68     return $rss_item;
69 }
70
71 sub get_sha256_sum($) {
72     my $file = shift;
73
74     open(my $fd, "<", $file)
75         or die "Can't open '$file' to generate checksum $!";
76     my $sha256 = Digest::SHA->new("SHA-256");
77     $sha256->addfile($fd);
78     close($fd);
79
80     return $sha256->hexdigest;
81 }
82
83 sub get_released_files($) {
84     my $scan_dir = shift;
85
86     my @Array = ();
87     my $i     = 0;
88     my $target;
89     my $target_sha256;
90     my $target_uri;
91     my $target_time;
92     my $target_line;
93
94     opendir(my $D1, $scan_dir) or die "Can't open 1st directory! /";
95     while (my $fi1 = readdir($D1)) {
96         next if ($fi1 =~ m/^\./);
97         next if ($fi1 eq 'OldFiles' or $fi1 eq 'pkgsrc');
98
99         opendir(my $D2, $scan_dir . $fi1 . '/')
100             or die "Can't open 2nd directory! /$fi1";
101         while (my $fi2 = readdir($D2)) {
102             next if ($fi2 =~ m/^\./);
103
104             # Start listing /OS/Version/FILE
105             opendir(my $D3, $scan_dir . $fi1 . '/' . $fi2 . '/')
106                 or die "Can't open 3rd directory! /$fi1/$fi2";
107             while (my $fi3 = readdir($D3)) {
108                 next if ($fi3 =~ m/^\./);
109                 $target = $scan_dir . $fi1 . '/' . $fi2 . '/' . $fi3;
110                 next if (!-e $target);    # skip if file is not exist
111
112                 $target_uri  = $fi1 . '/' . $fi2 . '/' . $fi3;
113                 $target_time = (stat $target)[9];
114
115                 $Array[$i] = ([$target_time, $target, $target_uri]);
116
117                 $i++;
118             }
119             closedir($D3);
120         }
121         closedir($D2);
122     }
123     closedir($D1);
124
125     return sort { @$a[0] <=> @$b[0] } @Array;
126 }
127
128 sub generate_feed($) {
129     my $scan_dir = shift;
130
131     # Result = Full XML Codes
132     my $result = '<?xml version="1.0" encoding="utf-8"?>
133  <rss xmlns:content="http://purl.org/rss/1.0/modules/content/" version="2.0">
134   <channel>
135    <title>Privoxy Releases</title>
136    <link>https://www.privoxy.org/announce.txt</link>
137    <description><![CDATA[Privoxy Releases RSS feed]]></description>
138    <pubDate>';
139     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = gmtime();
140     $result .=
141         "$days[$wday], $mday $months[$mon] "
142         . ($year + 1900)
143         . " $hour:$min:$sec GMT";
144     $result .= '</pubDate>';
145     $result .= "\n";
146
147     my @resArray = get_released_files($scan_dir);
148     my $i = @resArray - 1;
149     while ($max_advertised_files-- > 0 && $i >= 0) {
150         my $target_time =  $resArray[$i][0];
151         my $target = $resArray[$i][1];
152         my $target_uri =  $resArray[$i][2];
153
154         my $target_sha256 = get_sha256_sum($target);
155
156         my $rss_item = generate_rss_item($target, $target_uri, $target_time, $target_sha256);
157
158         $result .= $rss_item;
159         $i--;
160     }
161     $result .= '  </channel>
162    </rss>';
163
164     return $result;
165 }
166
167 sub main() {
168     my $scan_dir = shift(@ARGV)
169         or die "Local package directory not specified (first argument)\n";
170     my $save_rss_file = shift(@ARGV)
171         or die "RSS output file path not specified (second argument)\n";
172
173     my $result = generate_feed($scan_dir);
174
175     open(my $XMLF, ">", $save_rss_file) or die "Failed to write XML file";
176     print $XMLF $result;
177     close($XMLF);
178 }
179
180 main();