mirror/openssl
2
0
Fork 0
mirror of https://github.com/openssl/openssl.git synced 2025-03-31 20:10:45 +08:00
Code Issues Packages Projects Releases Wiki Activity

More utils cleanup.

Browse Source 
Remove some unused files.
Rename doc-nit-check to be consistent.
Add check for multiple #include in synopsis.

Reviewed-by: Richard Levitte <levitte@openssl.org>
This commit is contained in:
Rich Salz 2016-06-03 14:49:20 -04:00
parent e2ec7332c4
commit 843666ffdc
6 changed files with 37 additions and 213 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
util/copy-if-different.pl
View File

@ -1,84 +0,0 @@
#! /usr/bin/env perl
# Copyright 2013-2016 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the OpenSSL license (the "License"). You may not use
# this file except in compliance with the License. You can obtain a copy
# in the file LICENSE in the source distribution or at
# https://www.openssl.org/source/license.html
use strict;
use Fcntl;
# copy-if-different.pl
# Copy to the destination if the source is not the same as it.
my @filelist;
foreach my $arg (@ARGV) {
$arg =~ s|\\|/|g; # compensate for bug/feature in cygwin glob...
foreach (glob qq("$arg"))
{
push @filelist, $_;
}
}
my $fnum = @filelist;
if ($fnum <= 1)
{
die "Need at least two filenames";
}
my $dest = pop @filelist;
if ($fnum > 2 && ! -d $dest)
{
die "Destination must be a directory";
}
foreach (@filelist)
{
my $dfile;
if (-d $dest)
{
$dfile = $_;
$dfile =~ s|^.*[/\\]([^/\\]*)$|$1|;
$dfile = "$dest/$dfile";
}
else
{
$dfile = $dest;
}
my $buf;
if (-f $dfile)
{
sysopen(IN, $_, O_RDONLY|O_BINARY) || die "Can't Open $_";
sysopen(OUT, $dfile, O_RDONLY|O_BINARY)
|| die "Can't Open $dfile";
while (sysread IN, $buf, 10240)
{
my $b2;
goto copy if !sysread(OUT, $b2, 10240) || $buf ne $b2;
}
goto copy if sysread(OUT, $buf, 1);
close(IN);
close(OUT);
print "NOT copying: $_ to $dfile\n";
next;
}
copy:
sysopen(IN, $_, O_RDONLY|O_BINARY) || die "Can't Open $_";
sysopen(OUT, $dfile, O_WRONLY|O_CREAT|O_TRUNC|O_BINARY)
|| die "Can't Open $dfile";
while (sysread IN, $buf, 10240)
{
syswrite(OUT, $buf, length($buf));
}
close(IN);
close(OUT);
print "Copying: $_ to $dfile\n";
}

24
util/dirname.pl
View File

@ -1,24 +0,0 @@
#! /usr/bin/env perl
# Copyright 2002-2016 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the OpenSSL license (the "License"). You may not use
# this file except in compliance with the License. You can obtain a copy
# in the file LICENSE in the source distribution or at
# https://www.openssl.org/source/license.html
if ($#ARGV < 0) {
die "dirname.pl: too few arguments\n";
} elsif ($#ARGV > 0) {
die "dirname.pl: too many arguments\n";
}
my $d = $ARGV[0];
if ($d =~ m|.*/.*|) {
$d =~ s|/[^/]*$||;
} else {
$d = ".";
}
print $d,"\n";
exit(0);

33
util/extract-names.pl
View File

@ -1,33 +0,0 @@
#! /usr/bin/env perl
# Copyright 2002-2016 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the OpenSSL license (the "License"). You may not use
# this file except in compliance with the License. You can obtain a copy
# in the file LICENSE in the source distribution or at
# https://www.openssl.org/source/license.html
$/ = ""; # Eat a paragraph at once.
while(<STDIN>) {
s|\R$||;
s/\n/ /gm;
if (/^=head1 /) {
$name = 0;
} elsif ($name) {
if (/ - /) {
s/ - .*//;
s/,\s+/,/g;
s/\s+,/,/g;
s/^\s+//g;
s/\s+$//g;
s/\s/_/g;
push @words, split ',';
}
}
if (/^=head1 *NAME *$/) {
$name = 1;
}
}
print join("\n", @words),"\n";

18
util/extract-section.pl
View File

@ -1,18 +0,0 @@
#! /usr/bin/env perl
# Copyright 2004-2016 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the OpenSSL license (the "License"). You may not use
# this file except in compliance with the License. You can obtain a copy
# in the file LICENSE in the source distribution or at
# https://www.openssl.org/source/license.html
while(<STDIN>) {
if (/=for\s+comment\s+openssl_manual_section:(\S+)/)
{
print "$1\n";
exit 0;
}
}
print "$ARGV[0]\n";

51
util/doc-nit-check.pl → util/find-doc-nits.pl
View File

@ -32,6 +32,7 @@ sub check()
{
my $filename = shift;
my $dirname = basename(dirname($filename));
my $contents = '';
{
local $/ = undef;
@ -39,26 +40,48 @@ sub check()
$contents = <POD>;
close POD;
}
print $OUT "$filename doesn't start with =pod\n"
if $contents !~ /^=pod/;
print $OUT "$filename doesn't end with =cut\n"
if $contents !~ /=cut\n$/;
print $OUT "$filename more than one cut line.\n"
if $contents =~ /=cut.*=cut/ms;
print $OUT "$filename missing copyright\n"
if $contents !~ /Copyright .* The OpenSSL Project Authors/;
print $OUT "$filename copyright not last\n"
if $contents =~ /head1 COPYRIGHT.*=head/ms;
print $OUT "$filename head2 in All uppercase\n"
if $contents =~ /head2.*[A-Z ]+\n/;
my $section = $default_sections{$dirname};
my $id = "${filename}:1:";
print $OUT "$id doesn't start with =pod\n"
if $contents !~ /^=pod/;
print $OUT "$id doesn't end with =cut\n"
if $contents !~ /=cut\n$/;
print $OUT "$id more than one cut line.\n"
if $contents =~ /=cut.*=cut/ms;
print $OUT "$id missing copyright\n"
if $contents !~ /Copyright .* The OpenSSL Project Authors/;
print $OUT "$id copyright not last\n"
if $contents =~ /head1 COPYRIGHT.*=head/ms;
print $OUT "$id head2 in All uppercase\n"
if $contents =~ /head2\s+[A-Z ]+\n/;
# Look for multiple consecutive openssl #include lines.
# Consecutive because of files like md5.pod. Sometimes it's okay
# or necessary, as in ssl/SSL_set1_host.pod
if ( $contents !~ /=for comment multiple includes/ ) {
if ( $contents =~ /=head1 SYNOPSIS(.*)=head1 DESCRIPTION/ms ) {
my $count = 0;
foreach my $line ( split /\n+/, $1 ) {
if ( $line =~ m@include <openssl/@ ) {
if ( ++$count == 2 ) {
print $OUT "$id has multiple includes\n";
}
} else {
$count = 0;
}
}
}
}
# Find what section this page is in. If run from "." assume
# section 3.
my $section = $default_sections{$dirname} || 3;
if ($contents =~ /^=for\s+comment\s+openssl_manual_section:\s*(\d+)\s*$/m) {
$section = $1;
}
foreach ((@{$mandatory_sections{'*'}}, @{$mandatory_sections{$section}})) {
print $OUT "$filename doesn't have a head1 section matching $_\n"
print $OUT "$id doesn't have a head1 section matching $_\n"
if $contents !~ /^=head1\s+${_}\s*$/m;
}

40
util/perlpath.pl
View File

@ -1,40 +0,0 @@
#! /usr/bin/env perl
# Copyright 1995-2016 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the OpenSSL license (the "License"). You may not use
# this file except in compliance with the License. You can obtain a copy
# in the file LICENSE in the source distribution or at
# https://www.openssl.org/source/license.html
# modify the '#!/usr/local/bin/perl'
# line in all scripts that rely on perl.
require "find.pl";
$#ARGV == 0 || print STDERR "usage: perlpath newpath (eg /usr/bin)\n";
&find(".");
sub wanted
{
return unless /\.pl$/ || /^[Cc]onfigur/;
open(IN,"<$_") || die "unable to open $dir/$_:$!\n";
@a=<IN>;
close(IN);
if (-d $ARGV[0]) {
$a[0]="#!$ARGV[0]/perl\n";
}
else {
$a[0]="#!$ARGV[0]\n";
}
# Playing it safe...
$new="$_.new";
open(OUT,">$new") || die "unable to open $dir/$new:$!\n";
print OUT @a;
close(OUT);
rename($new,$_) || die "unable to rename $dir/$new:$!\n";
chmod(0755,$_) || die "unable to chmod $dir/$new:$!\n";
}