path: root/english/security/mk-dsa-dla-list

#! /usr/bin/perl

# This script is still used in 2024

# Copyright (C) 2022-2023  Thomas Lange <lange@debian.org>

# This program is free software; you can redistribute it and/or modify it
# under the terms of version 2 of the GNU General Public License as published
# by the Free Software Foundation.

# create list of recent DSA/DLA items with links to sec-tracker and to the mail

# how it works:
# get the last n DSA entries
# get mapping for DSA to URL on the mailing list archive
# check if there are manual fixes of the URL in data/*.fixes
# print list in text or HTML or CSS feed


use warnings;
use strict;
use Getopt::Std;
use Time::Piece;
use HTML::Entities;
use HTTP::Tiny;
use YAML::Tiny;
use XML::FeedPP;

our ($opt_s,$opt_f,$opt_F,$opt_m);

our $dsafile  = "data/dsa.data";
our $dsafixes = "data/dsa.fixes";
our $mldsa    = "https://lists.debian.org/debian-security-announce";

our $dlafile  = "data/dla.data";
our $dlafixes = "data/dla.fixes";
our $mldla    = "https://lists.debian.org/debian-lts-announce";

# security tracker URL
our $trurl  = "https://security-tracker.debian.org/tracker";

our $datafile = "data/description.yaml"; # yaml store for descriptions
our %data;  # contains the data (link and description for each DSA/DLA

# global variables
our %years;     # which years in the mail list archive must be parsed
our @reports;   # list of recent reports
our $nentries;
our $yaml;
our $write_yaml = 0;
our $feed;

sub usage {

  print << "EOM";

  mk-dsa-dla-list [option] type [count]

  type    can be DSA or DLA
  count   list the last count reports
  -m create apache redirect map for all DSA and DLA (no type needed)
  -s short list, no HTML
  -f create RSS feed short version
  -F create RSS feed long version including the description
EOM
  exit 0;
}



sub create_map {

  # map DSA-1234-1 (or DLA) to URL in mailing list archive

  # args: hash to store data, URL
  my $href = shift;
  my $url  = shift;

  my ($msg, $nr);

  my $response = HTTP::Tiny->new->get("$url");
  warn "Failed fetching $url!\n" unless $response->{success};
  my $cont = $response->{content} if length $response->{content};
  my @lines = split(/\cJ/,$cont);

  foreach (@lines) {
    next until /^<li>/;

    # regex include some special handling of DLA lines including
    # a second string in brackets line this: [SECURITY] [UPDATE] [DLA 2948-1] ...
    ($msg,$nr) = $_ =~ m#href="(msg\d+.html)">\[SECURITY\]\s+(?:\[[A-Z]+\]\s+)?\[(D[SL]A[\s-]+[-\d]+)#;
    warn "DEBUG: NR $url $_\n" unless defined($nr);
    warn "DEBUG: MSG $url $_\n" unless defined($msg);

    next unless defined $nr;
    $nr =~ s/(D[SL]A)\s+/$1-/; # make sure nr always is DSA-1234-1
    $href->{"$nr"}->[0] = "$url$msg";
  }
}

sub get_desc {

  my $dsa = shift;

  unless (defined $data{$dsa}->[1]) {
    $data{$dsa}->[1] = get_desc_text($data{$dsa}->[0]);
    $write_yaml = 1;
  }
  return $data{$dsa}->[1];
}

sub get_desc_text {

  # get the description text of the DSA/DLA

  my $url = shift;
  my $response = HTTP::Tiny->new->get("$url");
  warn "Failed fetching $url!\n" unless $response->{success};
  my $cont = $response->{content} if length $response->{content};

  # get description of announcement
  $cont =~ s/^\s+$/\n/mg;  # workaround for empty line (only with space) in DLA-3398-1
  # this regex should match the text of the security announcement (including CVE descriptions if added)
  $cont =~ /^(?:- )*-----------------.+Package.+?^$(.+?)(For the \S+ distribution |For Debian |We recommend )/ms;
  $_ = $1;

  decode_entities($_);
  s/^\n//;
  s/\n$//;
  return $_;
}

sub get_entries {

  # read $nentries entries and determine the years needed
  # save entries into array ref given, and set %years

  my $file = shift;
  my $aref = shift;
  my $i;

  open (F,"< $file") || die "Cannot open $file";
  foreach (<F>) {
    next until /^\[/;
    chomp;
    push @$aref,$_; # save line

    # match year only
    /^\[\d+\s+\w+\s+(\d+)\]/;
    $years{$1} = 1;
    $i++;
    last if ($i >= $nentries);
  }
  close("F");
}

sub mk_list {

  # create html or text output of recent security announcements

  my @list = @_;
  my ($date,$newdate,$dsa,$pkg,$text,$desc);
  my ($dummy,$type);

  foreach (@list) {

    ($date,$dsa,$pkg,$text) = m#\[(\d+\s+\w+\s+\d+)\]\s+(D[SL]A-\d+(?:-\d)?)\s+([\w.+-]+)\s*(?:-\s+)?(.+)?#;
    # no link was found, maybe due to typo on mailing list
    # or when the announcement mail is not yet in the mail list archive
    # then do not list this item, do not write description.yaml
    unless ($data{$dsa}->[0]) {
      warn "WARN: No link to mail for $dsa\n";
      undef $data{$dsa}->[0];
      $write_yaml = 1;
      $dsa =~ /(D[SL]A)/;
      $type = $1;
      open my $dummy, '>>', ".rebuild-$type";
      print $dummy "$dsa\n";
      close $dummy;
      next;
    }
    $data{$dsa}->[0] = $data{'none'}->[0] unless $data{$dsa}->[0];

    if ($opt_F || $opt_f) {
      $desc = "";
      if ($opt_F) {
        $desc = get_desc($dsa);
        $desc =~ s/^\s*$/<p>/msg;
      }
      my $item = $feed->add_item("$data{$dsa}->[0]");
      $item->title("$dsa $pkg - $text");
      $newdate = Time::Piece->strptime($date, '%d %b %Y')->strftime('%Y-%m-%d');
      $item->pubDate($newdate);
      $desc .= "\n<p>\n" if ($opt_F);
      $desc .= "<a href=\"https://security-tracker.debian.org/tracker/$dsa\">https://security-tracker.debian.org/tracker/$dsa</a>";
      $item->description($desc);

    } elsif ($opt_s) {
      # print short list
      print "$dsa $data{$dsa}->[0]\n";
    } else {
      print "<tt>[$date]</tt> <strong><a href=$trurl/$dsa> T</a> &ensp;<a href=\"$data{$dsa}->[0]\">$dsa $pkg</a></strong> $text<br>\n";
    }
  }
}

sub check_fixes {

  my $href = shift;
  my $fixfile = shift;
  my $baseurl = $href->{'none'}->[0];
  my $link;
  my $name;

  # read in all fixes
  open (F,"< $fixfile") || die "Cannot open $fixfile";
  while (<F>) {
    next if /^#/;
    ($name,$link) = m/(^D[SL]A-\S+)\s+(\S+)/;
    # replace entry if a fix is available
    warn "Fixing $name with $link\n";
    $href->{"$name"}->[0] = "$baseurl/$link";
  }
}

sub create_dsa_redirect {

  my $t = Time::Piece->new();
  foreach (2000..$t->year) {
    create_map(\%data, "$mldsa/$_/");
  }
  $data{'none'}->[0] = "$mldsa";
  check_fixes(\%data,$dsafixes);
  foreach (keys %data) {
    print "$_ $data{$_}->[0]\n";
  }
}

sub create_dla_redirect {

  my $t = Time::Piece->new();
  foreach my $y (2014..$t->year) {
    for ("01".."12") {
      # skip the future
      next if ( $t->year == $y && $_ > $t->mon );
      create_map(\%data, "$mldla/$y/$_/");
    }
  }
  $data{'none'}->[0] = "$mldla";
  check_fixes(\%data,$dlafixes);
  foreach (keys %data) {
    print "$_ $data{$_}->[0]\n";
  }
}

sub create_redirect_maps {

  create_dsa_redirect;
  undef %data;
  create_dla_redirect;
  exit 0;
}

# main program

getopts('sfFm');
$opt_m && create_redirect_maps;
my $type = shift;
usage unless $type =~/^D[SL]A$/;

# read how much entries to show from cmdline or use default
$nentries = shift || 49;

# initialize yaml structure if needed
  if ( -f $datafile ) {
    $yaml = YAML::Tiny->read( $datafile);
    %data = %{$yaml->[0]};
  } else {
    $yaml = YAML::Tiny->new( );
    $write_yaml = 1;
  }
if ($opt_f || $opt_F) {
  my $now = time();
  $feed = XML::FeedPP::RDF->new();
  $feed->title("Debian Security");
  $feed->link("https://www.debian.org/security/dsa.rdf");
  $feed->description("Debian Security Advisories");
  $feed->pubDate($now);
}

if ($type eq 'DSA') {
  get_entries($dsafile,\@reports);
  foreach (reverse sort keys %years) {
    create_map(\%data, "$mldsa/$_/");
  }
  # create a generic link for non-existing entries
  $data{'none'}->[0] = "$mldsa";
  check_fixes(\%data,$dsafixes);
  mk_list(@reports);
}

if ($type eq 'DLA') {
  get_entries($dlafile,\@reports);

  # DLA have a monthly index in the mailing list
  my $t = localtime;
  my $y;
  foreach $y (keys %years) {
    for ("01".."12") {
      # skip the future
      next if ( $t->year == $y && $_ > $t->mon );
      create_map(\%data, "$mldla/$y/$_/");
    }
  }
  # create a generic link for non-existing entries
  $data{'none'}->[0] = "$mldla";
  check_fixes(\%data,$dlafixes);
  mk_list(@reports);
}

$feed->to_file("index.rdf") if ($opt_f || $opt_F);
if ($write_yaml) {
  $yaml->[0] = \%data;
  $yaml->write($datafile) ;
}

exit 0;