make-changelog.pl

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5 use Text::CSV;
   6
   7 my $range = $ARGV[0];
   8 my $workdir = './openwrt-changelog-data';
   9
  10 unless (defined $range) {
  11         printf STDERR "Usage: $0 range\n";
  12         exit 1;
  13 }
  14
  15 unless (-d $workdir) {
  16         unless (system('mkdir', '-p', $workdir) == 0) {
  17                 printf STDERR "Unable to create work directory!\n";
  18                 exit 1;
  19         }
  20 }
  21
  22 my $commit_url = 'https://git.openwrt.org/?p=source.git;a=commitdiff;h=%s';
  23
  24 my @weblinks = (
  25         [ qr'^[^:]+://(git.lede-project.org/)(.+)$' => 'https://%s?p=%s;a=commitdiff;h=%%s' ],
  26         [ qr'^[^:]+://(git.openwrt.org/)(.+)$'      => 'https://%s?p=%s;a=commitdiff;h=%%s' ],
  27         [ qr'^[^:]+://(github.com/.+?)(?:\.git)?$'  => 'https://%s/commit/%%s' ],
  28         [ qr'^[^:]+://git.kernel.org/pub/scm/(.+)$' => 'https://git.kernel.org/cgit/%s/commit/?id=%%s' ],
  29         [ qr'^[^:]+://w1.fi/(?:.+/)?(.+)\.git$'     => 'https://w1.fi/cgit/%s/commit/?id=%%s' ],
  30         [ qr'^[^:]+://git.netfilter.org/(.+)'       => 'https://git.netfilter.org/%s/commit/?id=%%s' ],
  31         [ qr'^[^:]+://git.musl-libc.org/(.+)'       => 'https://git.musl-libc.org/cgit/%s/commit/?id=%%s' ],
  32         [ qr'^[^:]+://git.zx2c4.com/(.+)'           => 'https://git.zx2c4.com/%s/commit/?id=%%s' ],
  33 );
  34
  35
  36 my %topics;
  37 my %commits;
  38 my %reverts;
  39 my $index = 0;
  40
  41 sub line(*$)
  42 {
  43         my ($fh, $default) = @_;
  44
  45         my $line = readline $fh;
  46
  47         if (defined $line)
  48         {
  49                 chomp $line;
  50                 return $line;
  51         }
  52
  53         return $default;
  54 }
  55
  56 my @topic_paths = (
  57         [ qr'^package/(kernel)/linux',                 'Kernel' ],
  58         [ qr'^(target/linux/generic|include/kernel-version.mk)', 'Kernel' ],
  59         [ qr'^package/kernel/(mac80211)',              'Wireless / Common' ],
  60         [ qr'^package/kernel/(ath10k-ct)',             'Wireless / Ath10k CT' ],
  61         [ qr'^package/kernel/(mt76)',                  'Wireless / MT76' ],
  62         [ qr'^package/(base-files)/',                  'Packages / LEDE base files' ],
  63         [ qr'^package/(boot)/',                        'Packages / Boot Loaders' ],
  64         [ qr'^package/firmware/',                      'Packages / Firmware' ],
  65         [ qr'^package/.+/(uhttpd|usbmode|jsonfilter|ugps|libubox|procd|mountd|ubus|uci|usign|rpcd|fstools|ubox)/', 'Packages / LEDE system userland' ],
  66         [ qr'^package/.+/(iwinfo|umbim|uqmi|relayd|mdns|firewall|netifd|uclient|ustream-ssl|gre|ipip|qos-scripts|swconfig|vti|6in4|6rd|6to4|ds-lite|map|odhcp6c|odhcpd)/', 'Packages / LEDE network userland' ],
  67         [ qr'^package/[^/]+/([^/]+)',                  'Packages / Common' ],
  68         [ qr'^target/sdk/',                            'Build System / SDK' ],
  69         [ qr'^target/imagebuilder/',                   'Build System / Image Builder' ],
  70         [ qr'^target/toolchain/',                      'Build System / Toolchain' ],
  71         [ qr'^target/linux/([^/]+)',                   'Target / $1' ],
  72         [ qr'^(tools)/[^/]+',                          'Build System / Host Utilities' ],
  73         [ qr'^(toolchain)/[^/]+',                      'Build System / Toolchain' ],
  74         [ qr'^(config/|include/|scripts/|target/[^/]+$|Makefile|rules\.mk)', 'Build System / Buildroot' ],
  75         [ qr'^(feeds)\b',                              'Build System / Feeds' ],
  76 );
  77
  78 my @subhistory_matches = (
  79         qr'(?i)^\S+: update to\b',
  80         qr'(?i)^\S+: Upstep to\b',
  81         qr'(?i)^\S+: bump to\b',
  82         qr'(?i)^\S+: fix\b',
  83         qr'(?i)^\S+: backport\b',
  84         qr'(?i)\blatest HEAD\b',
  85 );
  86
  87 sub match_topics(@)
  88 {
  89         my %topics;
  90
  91         foreach my $path (@_)
  92         {
  93                 foreach my $rs (@topic_paths)
  94                 {
  95                         if ($path =~ $rs->[0])
  96                         {
  97                                 my $m = $1;
  98                                 my $s = $rs->[1];
  99
 100                                 $s =~ s!\$1!$m!g;
 101                                 $topics{$s}++;
 102
 103                                 last;
 104                         }
 105                 }
 106         }
 107
 108         my @topics = sort keys %topics;
 109         return (@topics > 0 ? @topics : ('Miscellaneous'));
 110 }
 111
 112 sub parse_history($$)
 113 {
 114         my ($dir, $range) = @_;
 115
 116         my @commits;
 117         my ($max_add, $total_add, $max_del, $total_del) = (0, 0, 0, 0);
 118
 119         if (open GIT, '-|', 'git', "--git-dir=$dir/.git", 'log', '--format=@@%n%H%n%s%n%b%n@@', '--numstat', '--reverse', '--no-merges', $range)
 120         {
 121                 # skip header line
 122                 line(*GIT, undef);
 123
 124                 while (1)
 125                 {
 126                         my $hash = line(GIT, '');
 127                         my $subject = line(GIT, '');
 128
 129                         last unless (length($subject) && $hash =~ m!^!);
 130
 131                         my $line = '';
 132                         my $body = '';
 133                         my @files;
 134                         my ($add, $del) = (0, 0);
 135
 136                         my $is_revert = $subject =~ m!^Revert !;
 137
 138                         $reverts{$hash}++ if $is_revert;
 139
 140                         while ($line ne '@@')
 141                         {
 142                                 $body .= length($line) ? "$line\n" : '';
 143                                 $line = line(*GIT, '@@');
 144
 145                                 if ($is_revert && $line =~ m!\b([0-9a-f]{40})\b!)
 146                                 {
 147                                         $reverts{$1}++;
 148                                 }
 149                         }
 150
 151                         $line = '';
 152
 153                         while ($line ne '@@')
 154                         {
 155                                 if ($line =~ m!^(\d+|-)\s+(\d+|-)\s+(.+)$!)
 156                                 {
 157                                         $add += ($1 eq '-') ? 0 : int($1);
 158                                         $del += ($2 eq '-') ? 0 : int($2);
 159                                         push @files, $3;
 160                                 }
 161
 162                                 $line = line(*GIT, '@@');
 163                         }
 164
 165                         my $commit = [
 166                                 $index++,
 167                                 $hash,
 168                                 $subject,
 169                                 $body,
 170                                 \@files,
 171                                 undef,
 172                                 undef,
 173                                 $add,
 174                                 $del
 175                         ];
 176
 177                         $total_add += $add;
 178                         $total_del += $del;
 179
 180                         $max_add = ($add > $max_add) ? $add : $max_add;
 181                         $max_del = ($del > $max_del) ? $del : $max_del;
 182
 183                         push @commits, $commit;
 184                 }
 185
 186                 close GIT;
 187         }
 188
 189         if (@commits > 0 && $commits[0][2] =~ /\brevert to branch defaults$/)
 190         {
 191                 shift @commits;
 192         }
 193
 194         return wantarray ? @commits : \@commits;
 195 }
 196
 197 sub fetch_subhistory($$$)
 198 {
 199         my ($url, $old, $new) = @_;
 200
 201         (my $path = $url) =~ s![^a-z0-9_-]+!-!g;
 202
 203         unless (-d "$workdir/repos/$path")
 204         {
 205                 mkdir("$workdir/repos");
 206                 system('git', 'clone', '--quiet', $url, "$workdir/repos/$path");
 207         }
 208         else
 209         {
 210                 system('git', "--work-tree=$workdir/repos/$path", "--git-dir=$workdir/repos/$path/.git", 'pull', '--quiet');
 211         }
 212
 213         return parse_history("$workdir/repos/$path", "$old..$new");
 214 }
 215
 216 sub requires_subhistory($$$)
 217 {
 218         my ($subject, $body, $hash) = @_;
 219
 220         foreach my $re (@subhistory_matches)
 221         {
 222                 if ($subject =~ $re || $body =~ $re)
 223                 {
 224                         if (open DIFF, '-|', 'git', 'diff', "$hash^!")
 225                         {
 226                                 my ($url, $old, $new);
 227
 228                                 while (defined(my $line = readline DIFF))
 229                                 {
 230                                         chomp $line;
 231
 232                                         if ($line =~ m!^[ +]PKG_SOURCE_URL\s*:?=\s*(\S+)!)
 233                                         {
 234                                                 $url = $1;
 235                                                 $url =~ s!\$\(LEDE_GIT\)!https://git.lede-project.org!g;
 236                                                 $url =~ s!\$\(OPENWRT_GIT\)!https://git.openwrt.org!g;
 237                                                 $url =~ s!\$\(PROJECT_GIT\)!https://git.openwrt.org!g;
 238                                         }
 239                                         elsif ($line =~ m!^-\S+\s*:?=\s*([a-f0-9]{40})\b!)
 240                                         {
 241                                                 $old = $1;
 242                                         }
 243                                         elsif ($line =~ m!^\+\S+\s*:?=\s*([a-f0-9]{40})\b!)
 244                                         {
 245                                                 $new = $1;
 246                                         }
 247
 248                                         if ($url && $old && $new)
 249                                         {
 250                                                 return ($url, $old, $new);
 251                                         }
 252                                 }
 253
 254                                 close DIFF;
 255                         }
 256                 }
 257         }
 258
 259         return ();
 260 }
 261
 262 sub find_weblink_template($)
 263 {
 264         my ($url) = @_;
 265
 266         foreach my $rt (@weblinks)
 267         {
 268                 my @m = $url =~ $rt->[0];
 269                 if (@m > 0)
 270                 {
 271                         return sprintf $rt->[1], @m;
 272                 }
 273         }
 274
 275         warn "No web link template for <$url>\n";
 276         return undef;
 277 }
 278
 279 sub format_stat($)
 280 {
 281         my ($commit) = @_;
 282
 283         my $s = '';
 284         my $c = '<color #ccc>%s</color>';
 285         my $g = '<color #282>%s</color>';
 286         my $r = '<color #f00>%s</color>';
 287
 288         if ($commit->[7] > 1000)
 289         {
 290                 $s .= sprintf $g, sprintf '+%.1fK', $commit->[7] / 1000;
 291         }
 292         elsif ($commit->[7] > 0)
 293         {
 294                 $s .= sprintf $g, sprintf '+%d', $commit->[7];
 295         }
 296
 297         if ($commit->[8] > 1000)
 298         {
 299                 $s .= $s ? sprintf($c, ',') : '';
 300                 $s .= sprintf $r, sprintf '-%.1fK', $commit->[8] / 1000;
 301         }
 302         elsif ($commit->[8] > 0)
 303         {
 304                 $s .= $s ? sprintf($c, ',') : '';
 305                 $s .= sprintf $r, sprintf '-%d', $commit->[8];
 306         }
 307
 308         return sprintf($c, '(') . $s . sprintf($c, ')');
 309 }
 310
 311 sub format_subject($$)
 312 {
 313         my ($subject, $body) = @_;
 314
 315         if (length($subject) > 80)
 316         {
 317                 $subject = substr($subject, 0, 77) . '...';
 318         }
 319
 320         $subject =~ s!^([^\s:]+):\s*!</nowiki>**<nowiki>$1:</nowiki>** <nowiki>!g;
 321
 322         $subject = sprintf '<nowiki>%s</nowiki>', $subject;
 323         $subject =~ s!<nowiki></nowiki>!!g;
 324
 325         return $subject;
 326 }
 327
 328 sub format_change($)
 329 {
 330         my ($change) = @_;
 331
 332         printf "''[[%s|%s]]'' %s //%s//\\\\\n",
 333                 sprintf($commit_url, $change->[1]),
 334                 substr($change->[1], 0, 7),
 335                 format_subject($change->[2], $change->[3]),
 336                 format_stat($change);
 337
 338         if ($change->[6])
 339         {
 340                 my $n = 0;
 341                 foreach my $subchange (@{$change->[6]})
 342                 {
 343                         if ($change->[5])
 344                         {
 345                                 printf " => ''[[%s|%s]]'' %s //%s//\\\\\n",
 346                                         sprintf($change->[5], $subchange->[1]),
 347                                         substr($subchange->[1], 0, 7),
 348                                         format_subject($subchange->[2], $subchange->[3]),
 349                                         format_stat($subchange);
 350                         }
 351                         else
 352                         {
 353                                 printf " => ''%s'' %s //%s//\\\\\n",
 354                                         substr($subchange->[1], 0, 7),
 355                                         format_subject($subchange->[2], $subchange->[3]),
 356                                         format_stat($subchange);
 357                         }
 358
 359                         if (++$n > 15 && @{$change->[6]} > $n)
 360                         {
 361                                 printf " => + //%u more...//\\\\\n", @{$change->[6]} - $n;
 362                                 last;
 363                         }
 364                 }
 365         }
 366 }
 367
 368 sub fetch_cve_info()
 369 {
 370         unless (-f "$workdir/cveinfo.csv")
 371         {
 372                 system('wget', '-O', "$workdir/cveinfo.csv.gz", 'https://cve.mitre.org/data/downloads/allitems.csv.gz') && return 0;
 373                 system('gunzip', '-f', "$workdir/cveinfo.csv.gz") && return 0;
 374         }
 375
 376         return 1;
 377 }
 378
 379 sub parse_cves(@)
 380 {
 381         my $csv = Text::CSV->new({ binary => 1 });
 382         my %cves;
 383
 384         if (fetch_cve_info() && $csv)
 385         {
 386                 if (open CVE, '<', "$workdir/cveinfo.csv")
 387                 {
 388                         while (defined(my $row = $csv->getline(*CVE)))
 389                         {
 390                                 foreach my $cve_id (@_)
 391                                 {
 392                                         if ($row->[0] eq $cve_id)
 393                                         {
 394                                                 $cves{$cve_id} = [$row->[2], $row->[6]];
 395                                                 last;
 396                                         }
 397                                 }
 398                         }
 399
 400                         close CVE;
 401                 }
 402         }
 403
 404         return \%cves;
 405 }
 406
 407 sub fetch_bug_info()
 408 {
 409         unless (-f "$workdir/buginfo.csv")
 410         {
 411                 system('wget', '-O', "$workdir/buginfo.csv", 'https://bugs.openwrt.org/index.php?string=&project=2&do=index&export_list=Export+Tasklist&advancedsearch=on&type%5B%5D=&sev%5B%5D=&pri%5B%5D=&due%5B%5D=&reported%5B%5D=&cat%5B%5D=&status%5B%5D=&percent%5B%5D=&opened=&dev=&closed=&duedatefrom=&duedateto=&changedfrom=&changedto=&openedfrom=&openedto=&closedfrom=&closedto=') && return 0;
 412         }
 413
 414         return 1;
 415 }
 416
 417 sub parse_bugs(@)
 418 {
 419         my $csv = Text::CSV->new({ binary => 1, allow_loose_quotes => 1 });
 420         my %bugs;
 421
 422         if (fetch_bug_info() && $csv)
 423         {
 424                 if (open BUG, '<', "$workdir/buginfo.csv")
 425                 {
 426                         while (defined(my $row = $csv->getline(*BUG)))
 427                         {
 428                                 foreach my $bug_id (@_)
 429                                 {
 430                                         if ($row->[0] eq $bug_id)
 431                                         {
 432                                                 $bugs{$bug_id} = [$row->[4], $row->[5]];
 433                                                 last;
 434                                         }
 435                                 }
 436                         }
 437
 438                         $csv->error_diag;
 439
 440                         close BUG;
 441                 }
 442         }
 443
 444         return \%bugs;
 445 }
 446
 447
 448 my @commits = parse_history('.', $range);
 449 my (%bugs, %cves);
 450
 451 foreach my $commit (@commits)
 452 {
 453         my @topics = match_topics(@{$commit->[4]});
 454
 455         unless ($commit->[5])
 456         {
 457                 my ($su, $so, $sn) = requires_subhistory($commit->[2], $commit->[3], $commit->[1]);
 458                 if ($su) {
 459                         $commit->[5] = find_weblink_template($su);
 460                         $commit->[6] = fetch_subhistory($su, $so, $sn);
 461                 }
 462         }
 463
 464         foreach my $topic (@topics)
 465         {
 466                 $topics{$topic} ||= [ ];
 467                 push @{$topics{$topic}}, $commit;
 468         }
 469
 470         my (%bug_ids, %cve_ids);
 471
 472         foreach my $bug ($commit->[2] =~ m!\b((?:[Pp]ull [Rr]equest |[Bb]ug |[Ii]ssue |PR |FS |GH |PR|FS|GH)#\d+)\b!g,
 473                          $commit->[3] =~ m!\b((?:[Pp]ull [Rr]equest |[Bb]ug |[Ii]ssue |PR |FS |GH |PR|FS|GH)#\d+)\b!g)
 474         {
 475                 if ($bug =~ m!^(?:Bug |Issue |FS |GH |FS|GH)#(\d+)$!i)
 476                 {
 477                         $bug_ids{$1}++;
 478                 }
 479         }
 480
 481         foreach my $cve ($commit->[2] =~ m!\b(CVE-\d+-\d+|\d+-CVE-\d+)\b!g,
 482                          $commit->[3] =~ m!\b(CVE-\d+-\d+|\d+-CVE-\d+)\b!g)
 483         {
 484                 # fix misspelled CVE IDs
 485                 $cve =~ s!^(\d+)-CVE-!CVE-$1-!;
 486                 $cve_ids{$cve}++;
 487         }
 488
 489         foreach my $bug (keys %bug_ids)
 490         {
 491                 $bugs{$bug} ||= [ ];
 492                 push @{$bugs{$bug}}, $commit;
 493         }
 494
 495         foreach my $cve (keys %cve_ids)
 496         {
 497                 $cves{$cve} ||= [ ];
 498                 push @{$cves{$cve}}, $commit;
 499         }
 500 }
 501
 502
 503 my @topics = sort { (($a eq 'Miscellaneous') <=> ($b eq 'Miscellaneous')) || $a cmp $b } keys %topics;
 504
 505 foreach my $topic (@topics)
 506 {
 507         my @commits = grep { !$reverts{$_->[1]} } @{$topics{$topic}};
 508
 509         printf "==== %s (%d change%s) ====\n", $topic, 0 + @commits, @commits > 1 ? 's' : '';
 510
 511         foreach my $change (sort { $a->[0] <=> $b->[0] } @commits)
 512         {
 513                 format_change($change);
 514         }
 515
 516         print "\n";
 517 }
 518
 519 my @bugs = sort { int($a) <=> int($b) } keys %bugs;
 520 my $bug_info = parse_bugs(@bugs);
 521
 522 @bugs = grep { $bug_info->{$_} && $bug_info->{$_}[0] } @bugs;
 523
 524 if (@bugs > 0)
 525 {
 526         printf "===== Addressed bugs =====\n";
 527
 528         foreach my $bug (@bugs)
 529         {
 530                 printf "=== #%s ===\n", $bug;
 531                 printf "**Description:** <nowiki>%s</nowiki>\\\\\n", $bug_info->{$bug}[0];
 532                 printf "**Link:** [[https://bugs.openwrt.org/index.php?do=details&task_id=%s]]\\\\\n", $bug;
 533                 printf "**Commits:**\\\\\n";
 534
 535                 foreach my $commit (@{$bugs{$bug}})
 536                 {
 537                         format_change($commit);
 538                 }
 539
 540                 printf "\\\\\n";
 541         }
 542
 543         printf "\n";
 544 }
 545
 546 my @cves =
 547         map { $_->[1] }
 548         sort { ($a->[0] <=> $b->[0]) || ($a->[1] cmp $b->[1]) }
 549         map { $_ =~ m!^CVE-(\d+)-(\d+)$! ? [ $1 * 10000000 + $2, $_ ] : [ 0, $_ ] }
 550         keys %cves;
 551
 552 my $cve_info = parse_cves(@cves);
 553
 554 if (@cves > 0)
 555 {
 556         printf "===== Security fixes ====\n";
 557
 558         foreach my $cve (@cves)
 559         {
 560                 printf "=== %s ===\n", $cve;
 561
 562                 if ($cve_info->{$cve} && $cve_info->{$cve}[0])
 563                 {
 564                         printf "**Description:** <nowiki>%s</nowiki>\n\n", $cve_info->{$cve}[0];
 565                 }
 566
 567                 printf "**Link:** [[https://cve.mitre.org/cgi-bin/cvename.cgi?name=%s]]\\\\\n", $cve;
 568                 printf "**Commits:**\\\\\n";
 569
 570                 foreach my $commit (@{$cves{$cve}})
 571                 {
 572                         format_change($commit);
 573                 }
 574
 575                 printf "\\\\\n";
 576         }
 577
 578         printf "\n";
 579 }