Mercurial > dropbear

comparison libtommath/helper.pl @ 1655:f52919ffd3b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
update ltm to 1.1.0 and enable FIPS 186.4 compliant key-generation (#79) * make key-generation compliant to FIPS 186.4 * fix includes in tommath_class.h * update fuzzcorpus instead of error-out * fixup fuzzing make-targets * update Makefile.in * apply necessary patches to ltm sources * clean-up not required ltm files * update to vanilla ltm 1.1.0 this already only contains the required files * remove set/get double
author Steffen Jaeckel <s_jaeckel@gmx.de>
date Mon, 16 Sep 2019 15:50:38 +0200
parents
children 1051e4eea25a
comparison
equal deleted inserted replaced
1654:cc0fc5131c5c 1655:f52919ffd3b1
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 check_source {
29 my @all_files = (
30 bsd_glob("makefile*"),
31 bsd_glob("*.{h,c,sh,pl}"),
32 bsd_glob("*/*.{h,c,sh,pl}"),
33 );
34
35 my $fails = 0;
36 for my $file (sort @all_files) {
37 my $troubles = {};
38 my $lineno = 1;
39 my $content = read_file($file);
40 push @{$troubles->{crlf_line_end}}, '?' if $content =~ /\r/;
41 for my $l (split /\n/, $content) {
42 push @{$troubles->{merge_conflict}}, $lineno if $l =~ /^(<<<<<<<|=======|>>>>>>>)([^<=>]|$)/;
43 push @{$troubles->{trailing_space}}, $lineno if $l =~ / $/;
44 push @{$troubles->{tab}}, $lineno if $l =~ /\t/ && basename($file) !~ /^makefile/i;
45 push @{$troubles->{non_ascii_char}}, $lineno if $l =~ /[^[:ascii:]]/;
46 push @{$troubles->{cpp_comment}}, $lineno if $file =~ /\.(c|h)$/ && ($l =~ /\s\/\// || $l =~ /\/\/\s/);
47 # we prefer using XMALLOC, XFREE, XREALLOC, XCALLOC ...
48 push @{$troubles->{unwanted_malloc}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmalloc\s*\(/;
49 push @{$troubles->{unwanted_realloc}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\brealloc\s*\(/;
50 push @{$troubles->{unwanted_calloc}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bcalloc\s*\(/;
51 push @{$troubles->{unwanted_free}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bfree\s*\(/;
52 # and we probably want to also avoid the following
53 push @{$troubles->{unwanted_memcpy}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemcpy\s*\(/;
54 push @{$troubles->{unwanted_memset}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemset\s*\(/;
55 push @{$troubles->{unwanted_memcpy}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemcpy\s*\(/;
56 push @{$troubles->{unwanted_memmove}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemmove\s*\(/;
57 push @{$troubles->{unwanted_memcmp}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemcmp\s*\(/;
58 push @{$troubles->{unwanted_strcmp}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrcmp\s*\(/;
59 push @{$troubles->{unwanted_strcpy}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrcpy\s*\(/;
60 push @{$troubles->{unwanted_strncpy}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrncpy\s*\(/;
61 push @{$troubles->{unwanted_clock}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bclock\s*\(/;
62 push @{$troubles->{unwanted_qsort}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bqsort\s*\(/;
63 push @{$troubles->{sizeof_no_brackets}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bsizeof\s*[^\(]/;
64 if ($file =~ m|^[^\/]+\.c$| && $l =~ /^static(\s+[a-zA-Z0-9_]+)+\s+([a-zA-Z0-9_]+)\s*\(/) {
65 my $funcname = $2;
66 # static functions should start with s_
67 push @{$troubles->{staticfunc_name}}, "$lineno($funcname)" if $funcname !~ /^s_/;
68 }
69 $lineno++;
70 }
71 for my $k (sort keys %$troubles) {
72 warn "[$k] $file line:" . join(",", @{$troubles->{$k}}) . "\n";
73 $fails++;
74 }
75 }
76
77 warn( $fails > 0 ? "check-source: FAIL $fails\n" : "check-source: PASS\n" );
78 return $fails;
79 }
80
81 sub check_comments {
82 my $fails = 0;
83 my $first_comment = <<'MARKER';
84 /* LibTomMath, multiple-precision integer library -- Tom St Denis
85 *
86 * LibTomMath is a library that provides multiple-precision
87 * integer arithmetic as well as number theoretic functionality.
88 *
89 * The library was designed directly after the MPI library by
90 * Michael Fromberger but has been written from scratch with
91 * additional optimizations in place.
92 *
93 * SPDX-License-Identifier: Unlicense
94 */
95 MARKER
96 my $last_comment = <<'MARKER';
97 /* ref: HEAD -> master, tag: v1.1.0 */
98 /* git commit: 08549ad6bc8b0cede0b357a9c341c5c6473a9c55 */
99 /* commit time: 2019-01-28 20:32:32 +0100 */
100 MARKER
101 #my @all_files = (bsd_glob("*.{h,c}"), bsd_glob("*/*.{h,c}"));
102 my @all_files = (bsd_glob("*.{h,c}"));
103 for my $f (@all_files) {
104 my $txt = read_file($f);
105 if ($txt !~ /\Q$first_comment\E/s) {
106 warn "[first_comment] $f\n";
107 $fails++;
108 }
109 if ($txt !~ /\Q$last_comment\E\s*$/s) {
110 warn "[last_comment] $f\n";
111 $fails++;
112 }
113 }
114 warn( $fails > 0 ? "check-comments: FAIL $fails\n" : "check-comments: PASS\n" );
115 return $fails;
116 }
117
118 sub prepare_variable {
119 my ($varname, @list) = @_;
120 my $output = "$varname=";
121 my $len = length($output);
122 foreach my $obj (sort @list) {
123 $len = $len + length $obj;
124 $obj =~ s/\*/\$/;
125 if ($len > 100) {
126 $output .= "\\\n";
127 $len = length $obj;
128 }
129 $output .= $obj . ' ';
130 }
131 $output =~ s/ $//;
132 return $output;
133 }
134
135 sub prepare_msvc_files_xml {
136 my ($all, $exclude_re, $targets) = @_;
137 my $last = [];
138 my $depth = 2;
139
140 # sort files in the same order as visual studio (ugly, I know)
141 my @parts = ();
142 for my $orig (@$all) {
143 my $p = $orig;
144 $p =~ s|/|/~|g;
145 $p =~ s|/~([^/]+)$|/$1|g;
146 my @l = map { sprintf "% -99s", $_ } split /\//, $p;
147 push @parts, [ $orig, join(':', @l) ];
148 }
149 my @sorted = map { $_->[0] } sort { $a->[1] cmp $b->[1] } @parts;
150
151 my $files = "<Files>\r\n";
152 for my $full (@sorted) {
153 my @items = split /\//, $full; # split by '/'
154 $full =~ s|/|\\|g; # replace '/' bt '\'
155 shift @items; # drop first one (src)
156 pop @items; # drop last one (filename.ext)
157 my $current = \@items;
158 if (join(':', @$current) ne join(':', @$last)) {
159 my $common = 0;
160 $common++ while ($last->[$common] && $current->[$common] && $last->[$common] eq $current->[$common]);
161 my $back = @$last - $common;
162 if ($back > 0) {
163 $files .= ("\t" x --$depth) . "</Filter>\r\n" for (1..$back);
164 }
165 my $fwd = [ @$current ]; splice(@$fwd, 0, $common);
166 for my $i (0..scalar(@$fwd) - 1) {
167 $files .= ("\t" x $depth) . "<Filter\r\n";
168 $files .= ("\t" x $depth) . "\tName=\"$fwd->[$i]\"\r\n";
169 $files .= ("\t" x $depth) . "\t>\r\n";
170 $depth++;
171 }
172 $last = $current;
173 }
174 $files .= ("\t" x $depth) . "<File\r\n";
175 $files .= ("\t" x $depth) . "\tRelativePath=\"$full\"\r\n";
176 $files .= ("\t" x $depth) . "\t>\r\n";
177 if ($full =~ $exclude_re) {
178 for (@$targets) {
179 $files .= ("\t" x $depth) . "\t<FileConfiguration\r\n";
180 $files .= ("\t" x $depth) . "\t\tName=\"$_\"\r\n";
181 $files .= ("\t" x $depth) . "\t\tExcludedFromBuild=\"true\"\r\n";
182 $files .= ("\t" x $depth) . "\t\t>\r\n";
183 $files .= ("\t" x $depth) . "\t\t<Tool\r\n";
184 $files .= ("\t" x $depth) . "\t\t\tName=\"VCCLCompilerTool\"\r\n";
185 $files .= ("\t" x $depth) . "\t\t\tAdditionalIncludeDirectories=\"\"\r\n";
186 $files .= ("\t" x $depth) . "\t\t\tPreprocessorDefinitions=\"\"\r\n";
187 $files .= ("\t" x $depth) . "\t\t/>\r\n";
188 $files .= ("\t" x $depth) . "\t</FileConfiguration>\r\n";
189 }
190 }
191 $files .= ("\t" x $depth) . "</File>\r\n";
192 }
193 $files .= ("\t" x --$depth) . "</Filter>\r\n" for (@$last);
194 $files .= "\t</Files>";
195 return $files;
196 }
197
198 sub patch_file {
199 my ($content, @variables) = @_;
200 for my $v (@variables) {
201 if ($v =~ /^([A-Z0-9_]+)\s*=.*$/si) {
202 my $name = $1;
203 $content =~ s/\n\Q$name\E\b.*?[^\\]\n/\n$v\n/s;
204 }
205 else {
206 die "patch_file failed: " . substr($v, 0, 30) . "..";
207 }
208 }
209 return $content;
210 }
211
212 sub version_from_tomcrypt_h {
213 my $h = read_file(shift);
214 if ($h =~ /\n#define\s*SCRYPT\s*"([0-9]+)\.([0-9]+)\.([0-9]+)(.*)"/s) {
215 return "VERSION_PC=$1.$2.$3", "VERSION_LT=1:1", "VERSION=$1.$2.$3$4", "PROJECT_NUMBER=$1.$2.$3$4";
216 }
217 else {
218 die "#define SCRYPT not found in tomcrypt.h";
219 }
220 }
221
222 sub process_makefiles {
223 my $write = shift;
224 my $changed_count = 0;
225 my @o = map { my $x = $_; $x =~ s/\.c$/.o/; $x } bsd_glob("*.c");
226 my @all = bsd_glob("*.{c,h}");
227
228 my $var_o = prepare_variable("OBJECTS", @o);
229 (my $var_obj = $var_o) =~ s/\.o\b/.obj/sg;
230
231 # update OBJECTS + HEADERS in makefile*
232 for my $m (qw/ Makefile.in /) {
233 my $old = read_file($m);
234 my $new = $m eq 'makefile.msvc' ? patch_file($old, $var_obj)
235 : patch_file($old, $var_o);
236 if ($old ne $new) {
237 write_file($m, $new) if $write;
238 warn "changed: $m\n";
239 $changed_count++;
240 }
241 }
242
243 if ($write) {
244 return 0; # no failures
245 }
246 else {
247 warn( $changed_count > 0 ? "check-makefiles: FAIL $changed_count\n" : "check-makefiles: PASS\n" );
248 return $changed_count;
249 }
250 }
251
252 sub die_usage {
253 die <<"MARKER";
254 usage: $0 -s OR $0 --check-source
255 $0 -o OR $0 --check-comments
256 $0 -m OR $0 --check-makefiles
257 $0 -a OR $0 --check-all
258 $0 -u OR $0 --update-makefiles
259 MARKER
260 }
261
262 GetOptions( "s|check-source" => \my $check_source,
263 "o|check-comments" => \my $check_comments,
264 "m|check-makefiles" => \my $check_makefiles,
265 "a|check-all" => \my $check_all,
266 "u|update-makefiles" => \my $update_makefiles,
267 "h|help" => \my $help
268 ) or die_usage;
269
270 my $failure;
271 $failure ||= check_source() if $check_all || $check_source;
272 $failure ||= check_comments() if $check_all || $check_comments;
273 $failure ||= process_makefiles(0) if $check_all || $check_makefiles;
274 $failure ||= process_makefiles(1) if $update_makefiles;
275
276 die_usage unless defined $failure;
277 exit $failure ? 1 : 0;
278
279 # ref: HEAD -> master, tag: v1.1.0
280 # git commit: 08549ad6bc8b0cede0b357a9c341c5c6473a9c55
281 # commit time: 2019-01-28 20:32:32 +0100