lib/hcrypto/libtommath/helper.pl

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Getopt::Long;
   7 use File::Find 'find';
   8 use File::Basename 'basename';
   9 use File::Glob 'bsd_glob';
  10
  11 sub read_file {
  12   my $f = shift;
  13   open my $fh, "<", $f or die "FATAL: read_rawfile() cannot open file '$f': $!";
  14   binmode $fh;
  15   return do { local $/; <$fh> };
  16 }
  17
  18 sub write_file {
  19   my ($f, $data) = @_;
  20   die "FATAL: write_file() no data" unless defined $data;
  21   open my $fh, ">", $f or die "FATAL: write_file() cannot open file '$f': $!";
  22   binmode $fh;
  23   print $fh $data or die "FATAL: write_file() cannot write to '$f': $!";
  24   close $fh or die "FATAL: write_file() cannot close '$f': $!";
  25   return;
  26 }
  27
  28 sub sanitize_comments {
  29   my($content) = @_;
  30   $content =~ s{/\*(.*?)\*/}{my $x=$1; $x =~ s/\w/x/g; "/*$x*/";}egs;
  31   return $content;
  32 }
  33
  34 sub check_source {
  35   my @all_files = (
  36         bsd_glob("makefile*"),
  37         bsd_glob("*.{h,c,sh,pl}"),
  38         bsd_glob("*/*.{h,c,sh,pl}"),
  39   );
  40
  41   my $fails = 0;
  42   for my $file (sort @all_files) {
  43     my $troubles = {};
  44     my $lineno = 1;
  45     my $content = read_file($file);
  46     $content = sanitize_comments $content;
  47     push @{$troubles->{crlf_line_end}}, '?' if $content =~ /\r/;
  48     for my $l (split /\n/, $content) {
  49       push @{$troubles->{merge_conflict}},     $lineno if $l =~ /^(<<<<<<<|=======|>>>>>>>)([^<=>]|$)/;
  50       push @{$troubles->{trailing_space}},     $lineno if $l =~ / $/;
  51       push @{$troubles->{tab}},                $lineno if $l =~ /\t/ && basename($file) !~ /^makefile/i;
  52       push @{$troubles->{non_ascii_char}},     $lineno if $l =~ /[^[:ascii:]]/;
  53       push @{$troubles->{cpp_comment}},        $lineno if $file =~ /\.(c|h)$/ && ($l =~ /\s\/\// || $l =~ /\/\/\s/);
  54       # we prefer using XMALLOC, XFREE, XREALLOC, XCALLOC ...
  55       push @{$troubles->{unwanted_malloc}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmalloc\s*\(/;
  56       push @{$troubles->{unwanted_realloc}},   $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\brealloc\s*\(/;
  57       push @{$troubles->{unwanted_calloc}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bcalloc\s*\(/;
  58       push @{$troubles->{unwanted_free}},      $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bfree\s*\(/;
  59       # and we probably want to also avoid the following
  60       push @{$troubles->{unwanted_memcpy}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemcpy\s*\(/;
  61       push @{$troubles->{unwanted_memset}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemset\s*\(/;
  62       push @{$troubles->{unwanted_memcpy}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemcpy\s*\(/;
  63       push @{$troubles->{unwanted_memmove}},   $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemmove\s*\(/;
  64       push @{$troubles->{unwanted_memcmp}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemcmp\s*\(/;
  65       push @{$troubles->{unwanted_strcmp}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrcmp\s*\(/;
  66       push @{$troubles->{unwanted_strcpy}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrcpy\s*\(/;
  67       push @{$troubles->{unwanted_strncpy}},   $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrncpy\s*\(/;
  68       push @{$troubles->{unwanted_clock}},     $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bclock\s*\(/;
  69       push @{$troubles->{unwanted_qsort}},     $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bqsort\s*\(/;
  70       push @{$troubles->{sizeof_no_brackets}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bsizeof\s*[^\(]/;
  71       if ($file =~ m|^[^\/]+\.c$| && $l =~ /^static(\s+[a-zA-Z0-9_]+)+\s+([a-zA-Z0-9_]+)\s*\(/) {
  72         my $funcname = $2;
  73         # static functions should start with s_
  74         push @{$troubles->{staticfunc_name}}, "$lineno($funcname)" if $funcname !~ /^s_/;
  75       }
  76       $lineno++;
  77     }
  78     for my $k (sort keys %$troubles) {
  79       warn "[$k] $file line:" . join(",", @{$troubles->{$k}}) . "\n";
  80       $fails++;
  81     }
  82   }
  83
  84   warn( $fails > 0 ? "check-source:    FAIL $fails\n" : "check-source:    PASS\n" );
  85   return $fails;
  86 }
  87
  88 sub check_comments {
  89   my $fails = 0;
  90   my $first_comment = <<'MARKER';
  91 /* LibTomMath, multiple-precision integer library -- Tom St Denis */
  92 /* SPDX-License-Identifier: Unlicense */
  93 MARKER
  94   #my @all_files = (bsd_glob("*.{h,c}"), bsd_glob("*/*.{h,c}"));
  95   my @all_files = (bsd_glob("*.{h,c}"));
  96   for my $f (@all_files) {
  97     my $txt = read_file($f);
  98     if ($txt !~ /\Q$first_comment\E/s) {
  99       warn "[first_comment] $f\n";
 100       $fails++;
 101     }
 102   }
 103   warn( $fails > 0 ? "check-comments:  FAIL $fails\n" : "check-comments:  PASS\n" );
 104   return $fails;
 105 }
 106
 107 sub check_doc {
 108   my $fails = 0;
 109   my $tex = read_file('doc/bn.tex');
 110   my $tmh = read_file('tommath.h');
 111   my @functions = $tmh =~ /\n\s*[a-zA-Z0-9_* ]+?(mp_[a-z0-9_]+)\s*\([^\)]+\)\s*;/sg;
 112   my @macros    = $tmh =~ /\n\s*#define\s+([a-z0-9_]+)\s*\([^\)]+\)/sg;
 113   for my $n (sort @functions) {
 114     (my $nn = $n) =~ s/_/\\_/g; # mp_sub_d >> mp\_sub\_d
 115     if ($tex !~ /index\Q{$nn}\E/) {
 116       warn "[missing_doc_for_function] $n\n";
 117       $fails++
 118     }
 119   }
 120   for my $n (sort @macros) {
 121     (my $nn = $n) =~ s/_/\\_/g; # mp_iszero >> mp\_iszero
 122     if ($tex !~ /index\Q{$nn}\E/) {
 123       warn "[missing_doc_for_macro] $n\n";
 124       $fails++
 125     }
 126   }
 127   warn( $fails > 0 ? "check_doc:       FAIL $fails\n" : "check-doc:       PASS\n" );
 128   return $fails;
 129 }
 130
 131 sub prepare_variable {
 132   my ($varname, @list) = @_;
 133   my $output = "$varname=";
 134   my $len = length($output);
 135   foreach my $obj (sort @list) {
 136     $len = $len + length $obj;
 137     $obj =~ s/\*/\$/;
 138     if ($len > 100) {
 139       $output .= "\\\n";
 140       $len = length $obj;
 141     }
 142     $output .= $obj . ' ';
 143   }
 144   $output =~ s/ $//;
 145   return $output;
 146 }
 147
 148 sub prepare_msvc_files_xml {
 149   my ($all, $exclude_re, $targets) = @_;
 150   my $last = [];
 151   my $depth = 2;
 152
 153   # sort files in the same order as visual studio (ugly, I know)
 154   my @parts = ();
 155   for my $orig (@$all) {
 156     my $p = $orig;
 157     $p =~ s|/|/~|g;
 158     $p =~ s|/~([^/]+)$|/$1|g;
 159     my @l = map { sprintf "% -99s", $_ } split /\//, $p;
 160     push @parts, [ $orig, join(':', @l) ];
 161   }
 162   my @sorted = map { $_->[0] } sort { $a->[1] cmp $b->[1] } @parts;
 163
 164   my $files = "<Files>\r\n";
 165   for my $full (@sorted) {
 166     my @items = split /\//, $full; # split by '/'
 167     $full =~ s|/|\\|g;             # replace '/' bt '\'
 168     shift @items; # drop first one (src)
 169     pop @items;   # drop last one (filename.ext)
 170     my $current = \@items;
 171     if (join(':', @$current) ne join(':', @$last)) {
 172       my $common = 0;
 173       $common++ while ($last->[$common] && $current->[$common] && $last->[$common] eq $current->[$common]);
 174       my $back = @$last - $common;
 175       if ($back > 0) {
 176         $files .= ("\t" x --$depth) . "</Filter>\r\n" for (1..$back);
 177       }
 178       my $fwd = [ @$current ]; splice(@$fwd, 0, $common);
 179       for my $i (0..scalar(@$fwd) - 1) {
 180         $files .= ("\t" x $depth) . "<Filter\r\n";
 181         $files .= ("\t" x $depth) . "\tName=\"$fwd->[$i]\"\r\n";
 182         $files .= ("\t" x $depth) . "\t>\r\n";
 183         $depth++;
 184       }
 185       $last = $current;
 186     }
 187     $files .= ("\t" x $depth) . "<File\r\n";
 188     $files .= ("\t" x $depth) . "\tRelativePath=\"$full\"\r\n";
 189     $files .= ("\t" x $depth) . "\t>\r\n";
 190     if ($full =~ $exclude_re) {
 191       for (@$targets) {
 192         $files .= ("\t" x $depth) . "\t<FileConfiguration\r\n";
 193         $files .= ("\t" x $depth) . "\t\tName=\"$_\"\r\n";
 194         $files .= ("\t" x $depth) . "\t\tExcludedFromBuild=\"true\"\r\n";
 195         $files .= ("\t" x $depth) . "\t\t>\r\n";
 196         $files .= ("\t" x $depth) . "\t\t<Tool\r\n";
 197         $files .= ("\t" x $depth) . "\t\t\tName=\"VCCLCompilerTool\"\r\n";
 198         $files .= ("\t" x $depth) . "\t\t\tAdditionalIncludeDirectories=\"\"\r\n";
 199         $files .= ("\t" x $depth) . "\t\t\tPreprocessorDefinitions=\"\"\r\n";
 200         $files .= ("\t" x $depth) . "\t\t/>\r\n";
 201         $files .= ("\t" x $depth) . "\t</FileConfiguration>\r\n";
 202       }
 203     }
 204     $files .= ("\t" x $depth) . "</File>\r\n";
 205   }
 206   $files .= ("\t" x --$depth) . "</Filter>\r\n" for (@$last);
 207   $files .= "\t</Files>";
 208   return $files;
 209 }
 210
 211 sub patch_file {
 212   my ($content, @variables) = @_;
 213   for my $v (@variables) {
 214     if ($v =~ /^([A-Z0-9_]+)\s*=.*$/si) {
 215       my $name = $1;
 216       $content =~ s/\n\Q$name\E\b.*?[^\\]\n/\n$v\n/s;
 217     }
 218     else {
 219       die "patch_file failed: " . substr($v, 0, 30) . "..";
 220     }
 221   }
 222   return $content;
 223 }
 224
 225 sub process_makefiles {
 226   my $write = shift;
 227   my $changed_count = 0;
 228   my @o = map { my $x = $_; $x =~ s/\.c$/.o/; $x } bsd_glob("*.c");
 229   my @all = bsd_glob("*.{c,h}");
 230
 231   my $var_o = prepare_variable("OBJECTS", @o);
 232   (my $var_obj = $var_o) =~ s/\.o\b/.obj/sg;
 233
 234   # update MSVC project files
 235   my $msvc_files = prepare_msvc_files_xml(\@all, qr/NOT_USED_HERE/, ['Debug|Win32', 'Release|Win32', 'Debug|x64', 'Release|x64']);
 236   for my $m (qw/libtommath_VS2008.vcproj/) {
 237     my $old = read_file($m);
 238     my $new = $old;
 239     $new =~ s|<Files>.*</Files>|$msvc_files|s;
 240     if ($old ne $new) {
 241       write_file($m, $new) if $write;
 242       warn "changed: $m\n";
 243       $changed_count++;
 244     }
 245   }
 246
 247   # update OBJECTS + HEADERS in makefile*
 248   for my $m (qw/ makefile makefile.shared makefile_include.mk makefile.msvc makefile.unix makefile.mingw /) {
 249     my $old = read_file($m);
 250     my $new = $m eq 'makefile.msvc' ? patch_file($old, $var_obj)
 251                                     : patch_file($old, $var_o);
 252     if ($old ne $new) {
 253       write_file($m, $new) if $write;
 254       warn "changed: $m\n";
 255       $changed_count++;
 256     }
 257   }
 258
 259   if ($write) {
 260     return 0; # no failures
 261   }
 262   else {
 263     warn( $changed_count > 0 ? "check-makefiles: FAIL $changed_count\n" : "check-makefiles: PASS\n" );
 264     return $changed_count;
 265   }
 266 }
 267
 268 sub draw_func
 269 {
 270    my ($deplist, $depmap, $out, $indent, $funcslist) = @_;
 271    my @funcs = split ',', $funcslist;
 272    # try this if you want to have a look at a minimized version of the callgraph without all the trivial functions
 273    #if ($deplist =~ /$funcs[0]/ || $funcs[0] =~ /BN_MP_(ADD|SUB|CLEAR|CLEAR_\S+|DIV|MUL|COPY|ZERO|GROW|CLAMP|INIT|INIT_\S+|SET|ABS|CMP|CMP_D|EXCH)_C/) {
 274    if ($deplist =~ /$funcs[0]/) {
 275       return $deplist;
 276    } else {
 277       $deplist = $deplist . $funcs[0];
 278    }
 279    if ($indent == 0) {
 280    } elsif ($indent >= 1) {
 281       print {$out} '|   ' x ($indent - 1) . '+--->';
 282    }
 283    print {$out} $funcs[0] . "\n";
 284    shift @funcs;
 285    my $olddeplist = $deplist;
 286    foreach my $i (@funcs) {
 287       $deplist = draw_func($deplist, $depmap, $out, $indent + 1, ${$depmap}{$i}) if exists ${$depmap}{$i};
 288    }
 289    return $olddeplist;
 290 }
 291
 292 sub update_dep
 293 {
 294     #open class file and write preamble
 295     open(my $class, '>', 'tommath_class.h') or die "Couldn't open tommath_class.h for writing\n";
 296     print {$class} << 'EOS';
 297 /* LibTomMath, multiple-precision integer library -- Tom St Denis */
 298 /* SPDX-License-Identifier: Unlicense */
 299
 300 #if !(defined(LTM1) && defined(LTM2) && defined(LTM3))
 301 #define LTM_INSIDE
 302 #if defined(LTM2)
 303 #   define LTM3
 304 #endif
 305 #if defined(LTM1)
 306 #   define LTM2
 307 #endif
 308 #define LTM1
 309 #if defined(LTM_ALL)
 310 EOS
 311
 312     foreach my $filename (glob 'bn*.c') {
 313         my $define = $filename;
 314
 315         print "Processing $filename\n";
 316
 317         # convert filename to upper case so we can use it as a define
 318         $define =~ tr/[a-z]/[A-Z]/;
 319         $define =~ tr/\./_/;
 320         print {$class} "#   define $define\n";
 321
 322         # now copy text and apply #ifdef as required
 323         my $apply = 0;
 324         open(my $src, '<', $filename);
 325         open(my $out, '>', 'tmp');
 326
 327         # first line will be the #ifdef
 328         my $line = <$src>;
 329         if ($line =~ /include/) {
 330             print {$out} $line;
 331         } else {
 332             print {$out} << "EOS";
 333 #include "tommath_private.h"
 334 #ifdef $define
 335 /* LibTomMath, multiple-precision integer library -- Tom St Denis */
 336 /* SPDX-License-Identifier: Unlicense */
 337 $line
 338 EOS
 339             $apply = 1;
 340         }
 341         while (<$src>) {
 342             if ($_ !~ /tommath\.h/) {
 343                 print {$out} $_;
 344             }
 345         }
 346         if ($apply == 1) {
 347             print {$out} "#endif\n";
 348         }
 349         close $src;
 350         close $out;
 351
 352         unlink $filename;
 353         rename 'tmp', $filename;
 354     }
 355     print {$class} "#endif\n#endif\n";
 356
 357     # now do classes
 358     my %depmap;
 359     foreach my $filename (glob 'bn*.c') {
 360         my $content;
 361         if ($filename =~ "bn_deprecated.c") {
 362             open(my $src, '<', $filename) or die "Can't open source file!\n";
 363             read $src, $content, -s $src;
 364             close $src;
 365         } else {
 366             my $cc = $ENV{'CC'} || 'gcc';
 367             $content = `$cc -E -x c -DLTM_ALL $filename`;
 368             $content =~ s/^# 1 "$filename".*?^# 2 "$filename"//ms;
 369         }
 370
 371         # convert filename to upper case so we can use it as a define
 372         $filename =~ tr/[a-z]/[A-Z]/;
 373         $filename =~ tr/\./_/;
 374
 375         print {$class} "#if defined($filename)\n";
 376         my $list = $filename;
 377
 378         # strip comments
 379         $content =~ s{/\*.*?\*/}{}gs;
 380
 381         # scan for mp_* and make classes
 382         my @deps = ();
 383         foreach my $line (split /\n/, $content) {
 384             while ($line =~ /(fast_)?(s_)?mp\_[a-z_0-9]*((?=\;)|(?=\())|(?<=\()mp\_[a-z_0-9]*(?=\()/g) {
 385                 my $a = $&;
 386                 next if $a eq "mp_err";
 387                 $a =~ tr/[a-z]/[A-Z]/;
 388                 $a = 'BN_' . $a . '_C';
 389                 push @deps, $a;
 390             }
 391         }
 392         @deps = sort(@deps);
 393         foreach my $a (@deps) {
 394             if ($list !~ /$a/) {
 395                 print {$class} "#   define $a\n";
 396             }
 397             $list = $list . ',' . $a;
 398         }
 399         $depmap{$filename} = $list;
 400
 401         print {$class} "#endif\n\n";
 402     }
 403
 404     print {$class} << 'EOS';
 405 #ifdef LTM_INSIDE
 406 #undef LTM_INSIDE
 407 #ifdef LTM3
 408 #   define LTM_LAST
 409 #endif
 410
 411 #include "tommath_superclass.h"
 412 #include "tommath_class.h"
 413 #else
 414 #   define LTM_LAST
 415 #endif
 416 EOS
 417     close $class;
 418
 419     #now let's make a cool call graph...
 420
 421     open(my $out, '>', 'callgraph.txt');
 422     foreach (sort keys %depmap) {
 423         draw_func("", \%depmap, $out, 0, $depmap{$_});
 424         print {$out} "\n\n";
 425     }
 426     close $out;
 427
 428     return 0;
 429 }
 430
 431 sub generate_def {
 432     my @files = split /\n/, `git ls-files`;
 433     @files = grep(/\.c/, @files);
 434     @files = map { my $x = $_; $x =~ s/^bn_|\.c$//g; $x; } @files;
 435     @files = grep(!/mp_radix_smap/, @files);
 436
 437     push(@files, qw(mp_set_int mp_set_long mp_set_long_long mp_get_int mp_get_long mp_get_long_long mp_init_set_int));
 438
 439     my $files = join("\n    ", sort(grep(/^mp_/, @files)));
 440     write_file "tommath.def", "; libtommath
 441 ;
 442 ; Use this command to produce a 32-bit .lib file, for use in any MSVC version
 443 ;   lib -machine:X86 -name:libtommath.dll -def:tommath.def -out:tommath.lib
 444 ; Use this command to produce a 64-bit .lib file, for use in any MSVC version
 445 ;   lib -machine:X64 -name:libtommath.dll -def:tommath.def -out:tommath.lib
 446 ;
 447 EXPORTS
 448     $files
 449 ";
 450     return 0;
 451 }
 452
 453 sub die_usage {
 454   die <<"MARKER";
 455 usage: $0 -s   OR   $0 --check-source
 456        $0 -o   OR   $0 --check-comments
 457        $0 -m   OR   $0 --check-makefiles
 458        $0 -a   OR   $0 --check-all
 459        $0 -u   OR   $0 --update-files
 460 MARKER
 461 }
 462
 463 GetOptions( "s|check-source"        => \my $check_source,
 464             "o|check-comments"      => \my $check_comments,
 465             "m|check-makefiles"     => \my $check_makefiles,
 466             "d|check-doc"           => \my $check_doc,
 467             "a|check-all"           => \my $check_all,
 468             "u|update-files"        => \my $update_files,
 469             "h|help"                => \my $help
 470           ) or die_usage;
 471
 472 my $failure;
 473 $failure ||= check_source()       if $check_all || $check_source;
 474 $failure ||= check_comments()     if $check_all || $check_comments;
 475 $failure ||= check_doc()          if $check_doc; # temporarily excluded from --check-all
 476 $failure ||= process_makefiles(0) if $check_all || $check_makefiles;
 477 $failure ||= process_makefiles(1) if $update_files;
 478 $failure ||= update_dep()         if $update_files;
 479 $failure ||= generate_def()       if $update_files;
 480
 481 die_usage unless defined $failure;
 482 exit $failure ? 1 : 0;