joachim99@14: #!/usr/bin/perl -w
joachim99@14: 
joachim99@14: # Check namespace cleanness of a library.
joachim99@14: # Allowed symbols are passed as arguments.
joachim99@14: # They may have trailing * = wildcard.
joachim99@14: # Wildcards may be also specified as *::* (e.g. K*::* for all KDE classes)
joachim99@14: # Symbols are listed as full function unmangled names without arguments,
joachim99@14: # e.g. 'foo bar* nspace::*' allows foo(), foo(int), bar(), barbar()
joachim99@14: # and all symbols in namespace/class nspace.
joachim99@14: # If an argument has comma in it, it's a filename of a file containing
joachim99@14: # allowed symbols, one per line.
joachim99@14: 
joachim99@14: 
joachim99@14: $thisProg   = "$0";     # This programs name
joachim99@14: 
joachim99@14: $library = "";
joachim99@14: $allowed_symbols = "";
joachim99@14: $debug = 0;
joachim99@14: $allowed_weak = "";
joachim99@14: $weak_specified = 0;
joachim99@14: 
joachim99@14: while( defined( $ARGV[ 0 ] ))
joachim99@14: {
joachim99@14:     $_ = shift;
joachim99@14:     if( /^--verbose$|^-v$/ )
joachim99@14:     {
joachim99@14: 	$debug = 1;
joachim99@14:     }
joachim99@14:     elsif( /^--help$|^-h$/ )
joachim99@14:     {
joachim99@14:         print STDOUT "Usage $thisProg [OPTION] ... library [allowed symbols] ...\n",
joachim99@14:                 "\n",
joachim99@14: 		"Check if the given library has only allowed public symbols.\n",
joachim99@14:                 "\n",
joachim99@14: 		"  --allowweak=[symbol] allow only these weak symbols\n",
joachim99@14:                 "  -v, --verbose        verbosely list files processed\n",
joachim99@14:                 "  -h, --help           print this help, then exit\n";
joachim99@14:         exit 0;
joachim99@14:     }
joachim99@14:     elsif( /^--allowweak=(.*)$/ )
joachim99@14:     {
joachim99@14: 	$allowed_weak .= " " . $1;
joachim99@14: 	$weak_specified = 1;
joachim99@14:     }
joachim99@14:     elsif( /^--allowweak$/ ) # simply list all weak
joachim99@14:     {
joachim99@14: 	$allowed_weak .= " ";
joachim99@14: 	$weak_specified = 1;
joachim99@14:     }
joachim99@14:     elsif( /^--*/ )
joachim99@14:     {
joachim99@14: 	die "Invalid argument!\n";
joachim99@14:     }
joachim99@14:     else
joachim99@14:     {
joachim99@14: 	if( ! $library )
joachim99@14: 	{
joachim99@14: 	    $library = $_;
joachim99@14: 	}
joachim99@14: 	else
joachim99@14: 	{
joachim99@14: 	    $allowed_symbols .= " " . $_;
joachim99@14: 	}
joachim99@14:     }
joachim99@14: }
joachim99@14: 
joachim99@14: if( ! $weak_specified )
joachim99@14: {
joachim99@14:     $allowed_weak = "*"; 
joachim99@14:     # allow all weak symbols by default
joachim99@14:     # instances of templates and similar stuff - unfortunately includes also things from other libraries,
joachim99@14:     # so it cannot be on by default
joachim99@14: }
joachim99@14: 
joachim99@14: print STDERR "library:" . $library . "\n" if $debug;
joachim99@14: print STDERR "allowed_symbols:" . $allowed_symbols . "\n" if $debug;
joachim99@14: print STDERR "allowed_weak:" . $allowed_weak . "\n" if $debug;
joachim99@14: 
joachim99@14: $default_symbols = "_fini _init";  # system symbols
joachim99@14: # on my system, every .so has :
joachim99@14: # A _DYNAMIC
joachim99@14: # A _GLOBAL_OFFSET_TABLE_
joachim99@14: # A __bss_start
joachim99@14: # A _edata
joachim99@14: # A _end
joachim99@14: # T _fini
joachim99@14: # T _init
joachim99@14: # no need to list A symbols in $default_symbols
joachim99@14: 
joachim99@14: print STDERR "default_symbols: " . $default_symbols . "\n" if $debug;
joachim99@14: 
joachim99@14: print STDOUT "Namespace cleanness check for " . $library . " :\n";
joachim99@14: 
joachim99@14: $lib_file = "";
joachim99@14: if( $library =~ /\.la$/ )
joachim99@14: {
joachim99@14:     # get the real library file from .la
joachim99@14:     open( FILEIN, $library ) || die "Couldn't open $! !\n";
joachim99@14:     while( $line = <FILEIN> )
joachim99@14:     {
joachim99@14: 	if( $line =~ /library_names=\'([^ ]*).*/o )
joachim99@14: 	{
joachim99@14: 	    $lib_file = $1;
joachim99@14: 	}
joachim99@14:     }
joachim99@14:     close( FILEIN );
joachim99@14:     if( ! $lib_file )
joachim99@14:     {
joachim99@14: 	print STDERR "Library file not found in .la file!\n";
joachim99@14: 	exit 1;
joachim99@14:     }
joachim99@14:     my $libpath = $library;
joachim99@14:     $libpath =~ s%[^/]*$%%;
joachim99@14:     if(  -e $libpath . ".libs/" . $lib_file )
joachim99@14:     {
joachim99@14: 	$lib_file = $libpath . ".libs/" . $lib_file;
joachim99@14:     }
joachim99@14:     else
joachim99@14:     {
joachim99@14: 	$lib_file = $libpath . $lib_file;
joachim99@14:     }
joachim99@14: }
joachim99@14: else
joachim99@14: {
joachim99@14:     $lib_file = $library;
joachim99@14: }
joachim99@14: 
joachim99@14: print STDERR "libfile: ". $lib_file . "\n" if $debug;
joachim99@14: 
joachim99@14: $allowed_symbols .= " " . $default_symbols;
joachim99@14: 
joachim99@14: sub process_symbols($\@\%\@);
joachim99@14: 
joachim99@14: @wildcards = ();
joachim99@14: %exacts = ();
joachim99@14: @regwildcards = ();
joachim99@14: process_symbols( $allowed_symbols, @wildcards, %exacts, @regwildcards );
joachim99@14: @weak_wildcards = ();
joachim99@14: %weak_exacts = ();
joachim99@14: @weak_regwildcards = ();
joachim99@14: process_symbols( $allowed_weak, @weak_wildcards, %weak_exacts, @weak_regwildcards );
joachim99@14: 
joachim99@14: # grep is for stripping not exported symbols, which don't have address (=first column)
joachim99@14: $nm_command = "nm -BDCg " . $lib_file . " | grep -v '^ ' |";
joachim99@14: 
joachim99@14: # TODO how portable is this nmcheck stuff?
joachim99@14: 
joachim99@14: print STDERR "nm command:" . $nm_command . "\n" if $debug;
joachim99@14: 
joachim99@14: open( FILEIN, $nm_command ) || die "nm command failed\n";
joachim99@14: 
joachim99@14: my $exit_code = 0;
joachim99@14: 
joachim99@14: while( $line = <FILEIN> )
joachim99@14: {
joachim99@14:     my $type;
joachim99@14:     my $symbol;
joachim99@14:     if( $line =~ /^[^ ]* (.) (.*)$/o )
joachim99@14:     {
joachim99@14: 	$type = $1;
joachim99@14: 	$symbol = $2;
joachim99@14:     }
joachim99@14:     else
joachim99@14:     {
joachim99@14: 	die "Invalid line: " . $line . "\n";
joachim99@14:     }
joachim99@14:     
joachim99@14:     print STDERR "Type: " . $type . " , symbol: " . $symbol . "\n" if $debug;
joachim99@14:     if( $type eq "A" )
joachim99@14:     { # these should be system symbols, so ignore them
joachim99@14: 	next;
joachim99@14:     }
joachim99@14: 
joachim99@14:     my $orig_symbol = $symbol;
joachim99@14: 
joachim99@14:     if( $symbol =~ /\(anonymous namespace\)/o )
joachim99@14:     { # TODO tell to prefer named namespaces? (shorter symbols)
joachim99@14: 	next;
joachim99@14:     }
joachim99@14: 
joachim99@14:     # strip prefixes
joachim99@14:     # the :: appending is to make "CLASS::*" work also for "vtable for CLASS"
joachim99@14:     $symbol =~ s/^typeinfo for (.*)$/$1::/o;
joachim99@14:     $symbol =~ s/^typeinfo fn for (.*)$/$1::/o;
joachim99@14:     $symbol =~ s/^typeinfo name for (.*)$/$1::/o;
joachim99@14:     $symbol =~ s/^vtable for (.*)$/$1::/o;
joachim99@14:     $symbol =~ s/^guard variable for (.*)$/$1::/o;
joachim99@14:     $symbol =~ s/^reference temporary for (.*)$/$1::/o;
joachim99@14:     $symbol =~ s/^VTT for (.*)$/$1::/o;
joachim99@14:     $symbol =~ s/^virtual thunk \[[^\]]*\] to (.*)$/$1::/o;
joachim99@14:     $symbol =~ s/^non-virtual thunk \[[^\]]*\] to (.*)$/$1::/o;
joachim99@14:     $symbol =~ s/^covariant return thunk \[[^\]]*\] to (.*)$/$1::/o;
joachim99@14:     $symbol =~ s/^construction vtable thunk for (.*)$/$1::/o;
joachim99@14:     $symbol =~ s/^construction vtable for .*-in-(.*) [0-9]*$/$1::/o;
joachim99@14: 
joachim99@14:     # templates seem to have also return types mangled in their name, and nm prints it too
joachim99@14:     # they have also template arguments in the symbol
joachim99@14:     # get rid of both of those
joachim99@14:     while( $symbol =~ /<.*>/o )
joachim99@14:     {
joachim99@14:         $symbol =~ s/<[^<>]*>//o; # strip innermost <>
joachim99@14:     }
joachim99@14:     if( $symbol !~ /operator\(\)/o )
joachim99@14:     {
joachim99@14: 	$symbol =~ s/ ?\(.*\).*$//o;  # strip () and all after it
joachim99@14:     }
joachim99@14:     else
joachim99@14:     {
joachim99@14: 	$symbol =~ s/(^|:| )operator\(\) ?\(.*\).*$//o;  # strip () and all after it
joachim99@14:     }
joachim99@14:     $symbol =~ s/\[.*\] *$//o;   # strip [in-charge] etc.
joachim99@14:     if( $symbol =~ /(^|:| )operator /o )
joachim99@14:     {
joachim99@14: 	$symbol =~ s/.* ([^\s]*)operator /$1/o; # strip everything before 'X::operator blah'
joachim99@14:     }
joachim99@14:     else
joachim99@14:     {
joachim99@14: 	$symbol =~ s/.* ([^\s]+) *$/$1/o;  # get last word (strip return type)
joachim99@14:     }
joachim99@14: 
joachim99@14:     # print STDERR "Processed symbol: " . $symbol . "\n" if $debug;
joachim99@14:     
joachim99@14:     my $found = 0;
joachim99@14:     if( $exacts{ $symbol } )
joachim99@14:     {
joachim99@14: 	$found = 1;
joachim99@14:     }
joachim99@14:     if( ! $found )
joachim99@14:     {
joachim99@14: 	for my $wild ( @wildcards )
joachim99@14: 	{
joachim99@14: 	    if( index( $symbol, $wild ) == 0 )
joachim99@14: 	    {
joachim99@14: 		$found = 1;
joachim99@14: 		last;
joachim99@14: 	    }
joachim99@14: 	}
joachim99@14:     }
joachim99@14:     if( ! $found )
joachim99@14:     {
joachim99@14: 	for my $wild ( @regwildcards )
joachim99@14: 	{
joachim99@14: 	    if( $symbol =~ /^$wild$/ )
joachim99@14: 	    {
joachim99@14: 		$found = 1;
joachim99@14: 		last;
joachim99@14: 	    }
joachim99@14: 	}
joachim99@14:     }
joachim99@14:     if( ( ! $found ) && ( $type eq "W" || $type eq "V" ))
joachim99@14:     {
joachim99@14: 	if( $weak_exacts{ $symbol } )
joachim99@14: 	{
joachim99@14: 	    $found = 1;
joachim99@14: 	}
joachim99@14: 	if( ! $found )
joachim99@14: 	{
joachim99@14: 	    for my $wild ( @weak_wildcards )
joachim99@14: 	    {
joachim99@14: 	        if( index( $symbol, $wild ) == 0 )
joachim99@14: 	        {
joachim99@14: 	    	    $found = 1;
joachim99@14: 		    last;
joachim99@14: 		}
joachim99@14: 	    }
joachim99@14: 	}
joachim99@14: 	if( ! $found )
joachim99@14: 	{
joachim99@14: 	    for my $wild ( @weak_regwildcards )
joachim99@14: 	    {
joachim99@14: 	        if( $symbol =~ /^$wild$/ )
joachim99@14: 	        {
joachim99@14: 		    $found = 1;
joachim99@14: 		    last;
joachim99@14: 	        }
joachim99@14: 	    }
joachim99@14: 	}
joachim99@14:     }
joachim99@14: 
joachim99@14:     if( ! $found )
joachim99@14:     {
joachim99@14: 	print STDERR "Public symbol " . $orig_symbol . " is not allowed!\n";
joachim99@14: 	$exit_code = 1;
joachim99@14:     }
joachim99@14: }
joachim99@14: 
joachim99@14: close( FILEIN );
joachim99@14: 
joachim99@14: print STDOUT $exit_code == 0 ? "OK\n" : "FAILED\n";
joachim99@14: 
joachim99@14: exit $exit_code;
joachim99@14: 
joachim99@14: sub process_symbols($\@\%\@)
joachim99@14: {
joachim99@14:     my $allowed_symbols = $_[ 0 ];
joachim99@14:     my $wildcards_ref = $_[ 1 ];
joachim99@14:     my $exacts_ref = $_[ 2 ];
joachim99@14:     my $regwildcards_ref = $_[ 3 ];
joachim99@14:     
joachim99@14:     $allowed_symbols =~ s/^ *//o;  # strip whitespace
joachim99@14:     $allowed_symbols =~ s/ *$//o;
joachim99@14: 
joachim99@14:     if( $allowed_symbols eq "NONE" )
joachim99@14:     {
joachim99@14: 	$allowed_symbols = "";
joachim99@14:     }
joachim99@14: 
joachim99@14:     my @symbols1 = split( ' ', $allowed_symbols );
joachim99@14:     my $i = 0;
joachim99@14:     my @symbols2 = ();
joachim99@14:     while( defined( $symbols1[ $i ] ))
joachim99@14:     {
joachim99@14: 	my $symbol = $symbols1[ $i ];
joachim99@14: 	if( $symbol =~ /\./ )  # dot in name -> file
joachim99@14: 	{
joachim99@14: 	    open( SYMIN, $symbol ) || die ( "Cannot open file " . $symbol . "!" );
joachim99@14: 	    while( $line = <SYMIN> )
joachim99@14: 	    {
joachim99@14: 		$line =~ s/^\s*//o;  # strip whitespace
joachim99@14: 		$line =~ s/\s*$//o;
joachim99@14: 		if( $line !~ /^$/o  # empty line
joachim99@14: 		    &&  $line !~ /^\s*#/ ) # comment line starting with #
joachim99@14: 		{
joachim99@14: 		    $symbols2[ $#symbols2 + 1 ] = $line;
joachim99@14: 		}
joachim99@14: 	    }
joachim99@14: 	    close( SYMIN );
joachim99@14: 	}
joachim99@14: 	else
joachim99@14: 	{
joachim99@14: 	    $symbols2[ $#symbols2 + 1 ] = $symbol;
joachim99@14: 	}
joachim99@14: 	$i++;
joachim99@14:     }
joachim99@14:     $i = 0;
joachim99@14:     while( defined( $symbols2[ $i ] ))
joachim99@14:     {
joachim99@14: 	my $symbol = $symbols2[ $i ];
joachim99@14: 	if( $symbol =~ /__/
joachim99@14: 	    || $symbol =~ /^_[A-Z]/ )
joachim99@14: 	{ # ISO C++ 2.10.2
joachim99@14: 	    die "Symbols containing a double underscore or beginning with an underscore and an upper-case letter are reserved!\n";
joachim99@14: 	}
joachim99@14: 	elsif( $symbol eq "main"
joachim99@14: 	    || $symbol eq "main*" )
joachim99@14: 	{
joachim99@14: 	    die "Symbol main is not allowed!\n";
joachim99@14: 	}
joachim99@14: 	if( $symbol =~ /^([^\*]*)\*$/o   # trailing * without any * before it
joachim99@14: 	    && $symbol !~ /operator\*$/o )
joachim99@14:         {
joachim99@14: 	    print STDERR "wildcard:" . $symbol . "\n" if $debug;
joachim99@14:     	    $wildcards_ref->[ $#{$wildcards_ref} + 1 ] = $1;
joachim99@14: 	}
joachim99@14: 	elsif( $symbol =~ /\*$/o
joachim99@14: 	    && ( $symbol =~ /\*::/o || $symbol =~ /::\*/o )
joachim99@14: 	    && $symbol !~ /^\*/o
joachim99@14: 	    && $symbol !~ /operator\*$/o )
joachim99@14: 	{
joachim99@14: 	    print STDERR "regwildcard:" . $symbol . "\n" if $debug;
joachim99@14: 	    $symbol =~ s/\*/\.\*/go;  # change * to .* (regexp)
joachim99@14: 	    $regwildcards_ref->[ $#{$regwildcards_ref} + 1 ] = $symbol;
joachim99@14: 	}
joachim99@14: 	else
joachim99@14: 	{
joachim99@14: 	    print STDERR "exact:" . $symbol . "\n" if $debug;
joachim99@14: 	    $exacts_ref->{ $symbol } = 1;
joachim99@14: 	}
joachim99@14: 	$i++;
joachim99@14:     }
joachim99@14: }