9b8fff6260
so we can remove all the duplicate registration implementations ...and we can put some other shared stuff in there as well
320 lines
13 KiB
Perl
Executable File
320 lines
13 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Getopt::Long;
|
|
use File::Find 'find';
|
|
use File::Basename 'basename';
|
|
use File::Glob 'bsd_glob';
|
|
|
|
sub read_file {
|
|
my $f = shift;
|
|
open my $fh, "<", $f or die "FATAL: read_rawfile() cannot open file '$f': $!";
|
|
binmode $fh;
|
|
return do { local $/; <$fh> };
|
|
}
|
|
|
|
sub write_file {
|
|
my ($f, $data) = @_;
|
|
die "FATAL: write_file() no data" unless defined $data;
|
|
open my $fh, ">", $f or die "FATAL: write_file() cannot open file '$f': $!";
|
|
binmode $fh;
|
|
print $fh $data or die "FATAL: write_file() cannot write to '$f': $!";
|
|
close $fh or die "FATAL: write_file() cannot close '$f': $!";
|
|
return;
|
|
}
|
|
|
|
sub check_source {
|
|
my @all_files = (bsd_glob("makefile*"), bsd_glob("*.sh"), bsd_glob("*.pl"));
|
|
find({ wanted=>sub { push @all_files, $_ if -f $_ }, no_chdir=>1 }, qw/src testprof demos/);
|
|
|
|
my $fails = 0;
|
|
for my $file (sort @all_files) {
|
|
next unless $file =~ /\.(c|h|pl|py|sh)$/ || basename($file) =~ /^makefile/i;
|
|
my $troubles = {};
|
|
my $lineno = 1;
|
|
my $content = read_file($file);
|
|
push @{$troubles->{crlf_line_end}}, '?' if $content =~ /\r/;
|
|
for my $l (split /\n/, $content) {
|
|
push @{$troubles->{merge_conflict}}, $lineno if $l =~ /^(<<<<<<<|=======|>>>>>>>)([^<=>]|$)/;
|
|
push @{$troubles->{trailing_space}}, $lineno if $l =~ / $/;
|
|
push @{$troubles->{tab}}, $lineno if $l =~ /\t/ && basename($file) !~ /^makefile/i;
|
|
push @{$troubles->{non_ascii_char}}, $lineno if $l =~ /[^[:ascii:]]/;
|
|
push @{$troubles->{cpp_comment}}, $lineno if $file =~ /\.(c|h)$/ && ($l =~ /\s\/\// || $l =~ /\/\/\s/);
|
|
# in ./src we prefer using XMEMCPY, XMALLOC, XFREE ...
|
|
push @{$troubles->{unwanted_memcpy}}, $lineno if $file =~ /^src\/.*\.c$/ && $l =~ /\bmemcpy\s*\(/;
|
|
push @{$troubles->{unwanted_malloc}}, $lineno if $file =~ /^src\/.*\.c$/ && $l =~ /\bmalloc\s*\(/;
|
|
push @{$troubles->{unwanted_realloc}}, $lineno if $file =~ /^src\/.*\.c$/ && $l =~ /\brealloc\s*\(/;
|
|
push @{$troubles->{unwanted_calloc}}, $lineno if $file =~ /^src\/.*\.c$/ && $l =~ /\bcalloc\s*\(/;
|
|
push @{$troubles->{unwanted_free}}, $lineno if $file =~ /^src\/.*\.c$/ && $l =~ /\bfree\s*\(/;
|
|
push @{$troubles->{unwanted_memset}}, $lineno if $file =~ /^src\/.*\.c$/ && $l =~ /\bmemset\s*\(/;
|
|
push @{$troubles->{unwanted_memcpy}}, $lineno if $file =~ /^src\/.*\.c$/ && $l =~ /\bmemcpy\s*\(/;
|
|
push @{$troubles->{unwanted_memcmp}}, $lineno if $file =~ /^src\/.*\.c$/ && $l =~ /\bmemcmp\s*\(/;
|
|
push @{$troubles->{unwanted_strcmp}}, $lineno if $file =~ /^src\/.*\.c$/ && $l =~ /\bstrcmp\s*\(/;
|
|
push @{$troubles->{unwanted_clock}}, $lineno if $file =~ /^src\/.*\.c$/ && $l =~ /\bclock\s*\(/;
|
|
push @{$troubles->{unwanted_qsort}}, $lineno if $file =~ /^src\/.*\.c$/ && $l =~ /\bqsort\s*\(/;
|
|
$lineno++;
|
|
}
|
|
for my $k (sort keys %$troubles) {
|
|
warn "[$k] $file line:" . join(",", @{$troubles->{$k}}) . "\n";
|
|
$fails++;
|
|
}
|
|
}
|
|
|
|
warn( $fails > 0 ? "check-source: FAIL $fails\n" : "check-source: PASS\n" );
|
|
return $fails;
|
|
}
|
|
|
|
sub check_defines {
|
|
my $fails = 0;
|
|
my $cust_h = read_file("src/headers/tomcrypt_custom.h");
|
|
my $cryp_c = read_file("src/misc/crypt/crypt.c");
|
|
$cust_h =~ s|/\*.*?\*/||sg; # remove comments
|
|
$cryp_c =~ s|/\*.*?\*/||sg; # remove comments
|
|
my %def = map { $_ => 1 } map { my $x = $_; $x =~ s/^\s*#define\s+(LTC_\S+).*$/$1/; $x } grep { /^\s*#define\s+LTC_\S+/ } split /\n/, $cust_h;
|
|
for my $d (sort keys %def) {
|
|
next if $d =~ /^LTC_(DH\d+|ECC\d+|ECC_\S+|MPI|MUTEX_\S+\(x\)|NO_\S+)$/;
|
|
warn "$d missing in src/misc/crypt/crypt.c\n" and $fails++ if $cryp_c !~ /\Q$d\E/;
|
|
}
|
|
warn( $fails > 0 ? "check-defines: FAIL $fails\n" : "check-defines: PASS\n" );
|
|
return $fails;
|
|
}
|
|
|
|
sub check_hashes {
|
|
my @src;
|
|
my @descriptors;
|
|
find({ wanted => sub { push @src, $_ if $_ =~ /\.c$/ }, no_chdir=>1 }, './src/hashes/');
|
|
for my $f (@src) {
|
|
my @n = map { my $x = $_; $x =~ s/^.*?ltc_hash_descriptor\s+(\S+).*$/$1/; $x } grep { $_ =~ /ltc_hash_descriptor/ } split /\n/, read_file($f);
|
|
push @descriptors, @n if @n;
|
|
}
|
|
my $fails = 0;
|
|
for my $d (@descriptors) {
|
|
for my $f (qw{ testprof/common.c }) {
|
|
my $txt = read_file($f);
|
|
warn "$d missing in $f\n" and $fails++ if $txt !~ /\Q$d\E/;
|
|
}
|
|
}
|
|
warn( $fails > 0 ? "check-hashes: FAIL $fails\n" : "check-hashes: PASS\n" );
|
|
return $fails;
|
|
}
|
|
|
|
sub prepare_variable {
|
|
my ($varname, @list) = @_;
|
|
my $output = "$varname=";
|
|
my $len = length($output);
|
|
foreach my $obj (sort @list) {
|
|
$len = $len + length $obj;
|
|
$obj =~ s/\*/\$/;
|
|
if ($len > 100) {
|
|
$output .= "\\\n";
|
|
$len = length $obj;
|
|
}
|
|
$output .= $obj . ' ';
|
|
}
|
|
$output =~ s/ $//;
|
|
return $output;
|
|
}
|
|
|
|
sub prepare_msvc_files_xml {
|
|
my ($all, $exclude_re, $targets) = @_;
|
|
my $last = [];
|
|
my $depth = 2;
|
|
|
|
# sort files in the same order as visual studio (ugly, I know)
|
|
my @parts = ();
|
|
for my $orig (@$all) {
|
|
my $p = $orig;
|
|
$p =~ s|/|/~|g;
|
|
$p =~ s|/~([^/]+)$|/$1|g;
|
|
# now we have: 'src/pk/rsa/rsa_verify_hash.c' > 'src/~pk/~rsa/rsa_verify_hash.c'
|
|
my @l = map { sprintf "% -99s", $_ } split /\//, $p;
|
|
push @parts, [ $orig, join(':', @l) ];
|
|
}
|
|
my @sorted = map { $_->[0] } sort { $a->[1] cmp $b->[1] } @parts;
|
|
|
|
my $files = "<Files>\r\n";
|
|
for my $full (@sorted) {
|
|
my @items = split /\//, $full; # split by '/'
|
|
$full =~ s|/|\\|g; # replace '/' bt '\'
|
|
shift @items; # drop first one (src)
|
|
pop @items; # drop last one (filename.ext)
|
|
my $current = \@items;
|
|
if (join(':', @$current) ne join(':', @$last)) {
|
|
my $common = 0;
|
|
$common++ while ($last->[$common] && $current->[$common] && $last->[$common] eq $current->[$common]);
|
|
my $back = @$last - $common;
|
|
if ($back > 0) {
|
|
$files .= ("\t" x --$depth) . "</Filter>\r\n" for (1..$back);
|
|
}
|
|
my $fwd = [ @$current ]; splice(@$fwd, 0, $common);
|
|
for my $i (0..scalar(@$fwd) - 1) {
|
|
$files .= ("\t" x $depth) . "<Filter\r\n";
|
|
$files .= ("\t" x $depth) . "\tName=\"$fwd->[$i]\"\r\n";
|
|
$files .= ("\t" x $depth) . "\t>\r\n";
|
|
$depth++;
|
|
}
|
|
$last = $current;
|
|
}
|
|
$files .= ("\t" x $depth) . "<File\r\n";
|
|
$files .= ("\t" x $depth) . "\tRelativePath=\"$full\"\r\n";
|
|
$files .= ("\t" x $depth) . "\t>\r\n";
|
|
if ($full =~ $exclude_re) {
|
|
for (@$targets) {
|
|
$files .= ("\t" x $depth) . "\t<FileConfiguration\r\n";
|
|
$files .= ("\t" x $depth) . "\t\tName=\"$_\"\r\n";
|
|
$files .= ("\t" x $depth) . "\t\tExcludedFromBuild=\"true\"\r\n";
|
|
$files .= ("\t" x $depth) . "\t\t>\r\n";
|
|
$files .= ("\t" x $depth) . "\t\t<Tool\r\n";
|
|
$files .= ("\t" x $depth) . "\t\t\tName=\"VCCLCompilerTool\"\r\n";
|
|
$files .= ("\t" x $depth) . "\t\t\tAdditionalIncludeDirectories=\"\"\r\n";
|
|
$files .= ("\t" x $depth) . "\t\t\tPreprocessorDefinitions=\"\"\r\n";
|
|
$files .= ("\t" x $depth) . "\t\t/>\r\n";
|
|
$files .= ("\t" x $depth) . "\t</FileConfiguration>\r\n";
|
|
}
|
|
}
|
|
########### aes_enc "hack" disabled - discussion: https://github.com/libtom/libtomcrypt/pull/158
|
|
# if ($full eq 'src\ciphers\aes\aes.c') { #hack
|
|
# my %cmd = (
|
|
# 'Debug|Win32' => [ 'Debug/aes.obj;Debug/aes_enc.obj', 'cl /nologo /MLd /W3 /Gm /GX /ZI /Od /I "src\headers" /I "..\libtommath" /D "_DEBUG" /D "LTM_DESC" /D "WIN32" /D "_MBCS" /D "_LIB" /D "LTC_SOURCE" /D "USE_LTM" /Fp"Debug/libtomcrypt.pch" /YX /Fo"Debug/" /Fd"Debug/" /FD /GZ /c $(InputPath)
cl /nologo /DENCRYPT_ONLY /MLd /W3 /Gm /GX /ZI /Od /I "src\headers" /I "..\libtommath" /D "_DEBUG" /D "LTM_DESC" /D "WIN32" /D "_MBCS" /D "_LIB" /D "LTC_SOURCE" /D "USE_LTM" /Fp"Debug/libtomcrypt.pch" /YX /Fo"Debug/aes_enc.obj" /Fd"Debug/" /FD /GZ /c $(InputPath)
' ],
|
|
# 'Release|Win32' => [ 'Release/aes.obj;Release/aes_enc.obj', 'cl /nologo /MLd /W3 /Gm /GX /ZI /Od /I "src\headers" /I "..\libtommath" /D "_DEBUG" /D "LTM_DESC" /D "WIN32" /D "_MBCS" /D "_LIB" /D "LTC_SOURCE" /D "USE_LTM" /Fp"Release/libtomcrypt.pch" /YX /Fo"Release/" /Fd"Release/" /FD /GZ /c $(InputPath)
cl /nologo /DENCRYPT_ONLY /MLd /W3 /Gm /GX /ZI /Od /I "src\headers" /I "..\libtommath" /D "_DEBUG" /D "LTM_DESC" /D "WIN32" /D "_MBCS" /D "_LIB" /D "LTC_SOURCE" /D "USE_LTM" /Fp"Release/libtomcrypt.pch" /YX /Fo"Release/aes_enc.obj" /Fd"Release/" /FD /GZ /c $(InputPath)
' ],
|
|
# );
|
|
# for (@$targets) {
|
|
# next unless $cmd{$_};
|
|
# $files .= ("\t" x $depth) . "\t<FileConfiguration\r\n";
|
|
# $files .= ("\t" x $depth) . "\t\tName=\"$_\"\r\n";
|
|
# $files .= ("\t" x $depth) . "\t\t>\r\n";
|
|
# $files .= ("\t" x $depth) . "\t\t<Tool\r\n";
|
|
# $files .= ("\t" x $depth) . "\t\t\tName=\"VCCustomBuildTool\"\r\n";
|
|
# $files .= ("\t" x $depth) . "\t\t\tCommandLine=\"$cmd{$_}[1]\"\r\n";
|
|
# $files .= ("\t" x $depth) . "\t\t\tOutputs=\"$cmd{$_}[0]\"\r\n";
|
|
# $files .= ("\t" x $depth) . "\t\t/>\r\n";
|
|
# $files .= ("\t" x $depth) . "\t</FileConfiguration>\r\n";
|
|
# }
|
|
# }
|
|
$files .= ("\t" x $depth) . "</File>\r\n";
|
|
}
|
|
$files .= ("\t" x --$depth) . "</Filter>\r\n" for (@$last);
|
|
$files .= "\t</Files>";
|
|
return $files;
|
|
}
|
|
|
|
sub patch_makefile {
|
|
my ($content, @variables) = @_;
|
|
for my $v (@variables) {
|
|
if ($v =~ /^([A-Z0-9_]+)\s*=.*$/si) {
|
|
my $name = $1;
|
|
$content =~ s/\n\Q$name\E\b.*?[^\\]\n/\n$v\n/s;
|
|
}
|
|
else {
|
|
die "patch_makefile failed: " . substr($v, 0, 30) . "..";
|
|
}
|
|
}
|
|
return $content;
|
|
}
|
|
|
|
sub version_form_tomcrypt_h {
|
|
my $h = read_file(shift);
|
|
if ($h =~ /\n#define\s*SCRYPT\s*"([0-9]+)\.([0-9]+)"/s) {
|
|
return "VERSION=$1.$2", "VERSION_LT=0:$1$2";
|
|
}
|
|
else {
|
|
die "#define SCRYPT not found in tomcrypt.h";
|
|
}
|
|
}
|
|
|
|
sub process_makefiles {
|
|
my $write = shift;
|
|
my $changed_count = 0;
|
|
my @c = ();
|
|
find({ no_chdir => 1, wanted => sub { push @c, $_ if -f $_ && $_ =~ /\.c$/ && $_ !~ /tab.c$/ } }, 'src');
|
|
my @h = ();
|
|
find({ no_chdir => 1, wanted => sub { push @h, $_ if -f $_ && $_ =~ /\.h$/ && $_ !~ /dh_static.h$/ } }, 'src');
|
|
my @all = ();
|
|
find({ no_chdir => 1, wanted => sub { push @all, $_ if -f $_ && $_ =~ /\.(c|h)$/ } }, 'src');
|
|
my @t = qw();
|
|
find({ no_chdir => 1, wanted => sub { push @t, $_ if $_ =~ /(common|no_prng|test_driver|x86_prof|_tests?).c$/ } }, 'testprof');
|
|
|
|
my @o = sort ('src/ciphers/aes/aes_enc.o', map { my $x = $_; $x =~ s/\.c$/.o/; $x } @c);
|
|
my $var_o = prepare_variable("OBJECTS", @o);
|
|
my $var_h = prepare_variable("HEADERS", (sort @h));
|
|
(my $var_obj = $var_o) =~ s/\.o\b/.obj/sg;
|
|
|
|
my $var_to = prepare_variable("TOBJECTS", sort map { my $x = $_; $x =~ s/\.c$/.o/; $x } @t);
|
|
(my $var_tobj = $var_to) =~ s/\.o\b/.obj/sg;
|
|
|
|
my @ver_version = version_form_tomcrypt_h("src/headers/tomcrypt.h");
|
|
|
|
# update MSVC project files
|
|
my $msvc_files = prepare_msvc_files_xml(\@all, qr/tab\.c$/, ['Debug|Win32', 'Release|Win32', 'Debug|x64', 'Release|x64']);
|
|
for my $m (qw/libtomcrypt_VS2008.vcproj/) {
|
|
my $old = read_file($m);
|
|
my $new = $old;
|
|
$new =~ s|<Files>.*</Files>|$msvc_files|s;
|
|
if ($old ne $new) {
|
|
write_file($m, $new) if $write;
|
|
warn "changed: $m\n";
|
|
$changed_count++;
|
|
}
|
|
}
|
|
|
|
# update OBJECTS + HEADERS in makefile*
|
|
for my $m (qw/ makefile makefile.shared makefile.unix makefile.mingw makefile.msvc makefile_include.mk /) {
|
|
my $old = read_file($m);
|
|
my $new = $m eq 'makefile.msvc' ? patch_makefile($old, $var_obj, $var_h, $var_tobj, @ver_version)
|
|
: patch_makefile($old, $var_o, $var_h, $var_to, @ver_version);
|
|
if ($old ne $new) {
|
|
write_file($m, $new) if $write;
|
|
warn "changed: $m\n";
|
|
$changed_count++;
|
|
}
|
|
}
|
|
|
|
if ($write) {
|
|
return 0; # no failures
|
|
}
|
|
else {
|
|
warn( $changed_count > 0 ? "check-makefiles: FAIL $changed_count\n" : "check-makefiles: PASS\n" );
|
|
return $changed_count;
|
|
}
|
|
}
|
|
|
|
sub die_usage {
|
|
die <<"MARKER";
|
|
usage: $0 --check-source
|
|
$0 --check-defines
|
|
$0 --check-makefiles
|
|
$0 --check-all
|
|
$0 --update-makefiles
|
|
$0 --fixupind crypt.ind
|
|
MARKER
|
|
}
|
|
|
|
GetOptions( "s|check-source" => \my $check_source,
|
|
"d|check-defines" => \my $check_defines,
|
|
"h|check-hashes" => \my $check_hashes,
|
|
"m|check-makefiles" => \my $check_makefiles,
|
|
"a|check-all" => \my $check_all,
|
|
"u|update-makefiles" => \my $update_makefiles,
|
|
"f|fixupind=s" => \my $fixupind,
|
|
"h|help" => \my $help
|
|
) or die_usage;
|
|
|
|
if ($fixupind) {
|
|
my $txt = read_file($fixupind);
|
|
$txt =~ s/^([^\n]*\n)/$1\n\\addcontentsline{toc}{chapter}{Index}\n/s;
|
|
write_file($fixupind, $txt);
|
|
exit 0;
|
|
}
|
|
|
|
my $failure;
|
|
$failure ||= check_source() if $check_all || $check_source;
|
|
$failure ||= check_defines() if $check_all || $check_defines;
|
|
$failure ||= check_hashes() if $check_all || $check_hashes;
|
|
$failure ||= process_makefiles(0) if $check_all || $check_makefiles;
|
|
$failure ||= process_makefiles(1) if $update_makefiles;
|
|
|
|
die_usage unless defined $failure;
|
|
exit $failure ? 1 : 0;
|