third_party/mbedtls/repo/scripts/rename.pl

   1 #!/usr/bin/env perl
   2 #
   3 # This file is part of mbed TLS (https://tls.mbed.org)
   4 #
   5 # Copyright (c) 2015-2016, ARM Limited, All Rights Reserved
   6 #
   7 # Purpose
   8 #
   9 # This script migrates application source code from the mbed TLS 1.3 API to the
  10 # mbed TLS 2.0 API.
  11 #
  12 # The script processes the given source code and renames identifiers - functions
  13 # types, enums etc, as
  14 #
  15 # Usage:  rename.pl [-f datafile] [-s] [--] [filenames...]
  16 #
  17
  18 use warnings;
  19 use strict;
  20
  21 use utf8;
  22 use Path::Class;
  23 use open qw(:std utf8);
  24
  25 my $usage = "Usage: $0 [-f datafile] [-s] [--] [filenames...]\n";
  26
  27 (my $datafile = $0) =~ s/rename.pl$/data_files\/rename-1.3-2.0.txt/;
  28 my $do_strings = 0;
  29
  30 while( @ARGV && $ARGV[0] =~ /^-/ ) {
  31     my $opt = shift;
  32     if( $opt eq '--' ) {
  33         last;
  34     } elsif( $opt eq '-f' ) {
  35         $datafile = shift;
  36     } elsif( $opt eq '-s' ) {
  37         $do_strings = 1; shift;
  38     } else {
  39         die $usage;
  40     }
  41 }
  42
  43 my %subst;
  44 open my $nfh, '<', $datafile or die "Could not read $datafile\n";
  45 my $ident = qr/[_A-Za-z][_A-Za-z0-9]*/;
  46 while( my $line = <$nfh> ) {
  47     chomp $line;
  48     my ( $old, $new ) = ( $line =~ /^($ident)\s+($ident)$/ );
  49     if( ! $old || ! $new ) {
  50         die "$0: $datafile:$.: bad input '$line'\n";
  51     }
  52     $subst{$old} = $new;
  53 }
  54 close $nfh or die;
  55
  56 my $string = qr/"(?:\\.|[^\\"])*"/;
  57 my $space = qr/\s+/;
  58 my $idnum = qr/[a-zA-Z0-9_]+/;
  59 my $symbols = qr/[-!#\$%&'()*+,.\/:;<=>?@[\\\]^_`{|}~]+|"/;
  60
  61 my $lib_include_dir = dir($0)->parent->parent->subdir('include', 'mbedtls');
  62 my $lib_source_dir = dir($0)->parent->parent->subdir('library');
  63
  64 # if we replace inside strings, we don't consider them a token
  65 my $token = $do_strings ?         qr/$space|$idnum|$symbols/
  66                         : qr/$string|$space|$idnum|$symbols/;
  67
  68 my %warnings;
  69
  70 # If no files were passed, exit...
  71 if ( not defined($ARGV[0]) ){ die $usage; }
  72
  73 while( my $filename = shift )
  74 {
  75     print STDERR "$filename... ";
  76
  77     if( dir($filename)->parent eq $lib_include_dir ||
  78          dir($filename)->parent eq $lib_source_dir )
  79     {
  80         die "Script cannot be executed on the mbed TLS library itself.";
  81     }
  82
  83     if( -d $filename ) { print STDERR "skip (directory)\n"; next }
  84
  85     open my $rfh, '<', $filename or die;
  86     my @lines = <$rfh>;
  87     close $rfh or die;
  88
  89     my @out;
  90     for my $line (@lines) {
  91         if( $line =~ /#include/ ) {
  92             $line =~ s/polarssl/mbedtls/;
  93             $line =~ s/POLARSSL/MBEDTLS/;
  94             push( @out, $line );
  95             next;
  96         }
  97
  98         my @words = ($line =~ /$token/g);
  99         my $checkline = join '', @words;
 100         if( $checkline eq $line ) {
 101             my @new = map { exists $subst{$_} ? $subst{$_} : $_ } @words;
 102             push( @out, join '', @new );
 103         } else {
 104             $warnings{$filename} = [] unless $warnings{$filename};
 105             push @{ $warnings{$filename} }, $line;
 106             push( @out, $line );
 107         }
 108     }
 109
 110     open my $wfh, '>', $filename or die;
 111     print $wfh $_ for @out;
 112     close $wfh or die;
 113     print STDERR "done\n";
 114 }
 115
 116 if( %warnings ) {
 117     print "\nWarning: lines skipped due to unexpected characters:\n";
 118     for my $filename (sort keys %warnings) {
 119         print "in $filename:\n";
 120         print for @{ $warnings{$filename} };
 121     }
 122 }