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();