Ticket #359: tt359-pbc_uuid.2.patch

File tt359-pbc_uuid.2.patch, 13.2 KB (added by rurban, 5 years ago)

binary safe 22 byte UUID (base_64)

  • lib/Parrot/BuildUtil.pm

    [core] TT #359 implement pbc_uuid writing
    - pbc_uuid now binary safe, as md5_base64 size=23
    - pbc_uuid is calculated in auto::pmc, after auto::ops. 
      Two use-cases:
      1) on user-defined pmc and ops take this name list, plus bc_major, bc_minor.
      2) default: md5 of PBC_COMPAT
    - What should else should be taken into the uuid? I just have the pmc and ops
      names plus bc version, but in reality all the public interfaces are needed also.
    - Two generic pbc functions are moved to Parrot::BuildUtil, get_bc_version() and
      generate_pbc_fingerprint(). This simplifies dev/pbc_header.pl and
      tools/build/pbcversion_h.pl.
    - Added an exported Parrot_freeze_size, currently the same as Parrot_freeze, 
      but should internally use VISIT_FREEZE_SIZE, not to malloc/free around like crazy.
    
    Missing:
    - warnings/errors on mismatches.
    - generate better a UUID, based on changed interfaces (configure-time), not
      a required change description in PBC_COMPAT.
    
    old new  
    1212 
    1313=head1 DESCRIPTION 
    1414 
    15 This package holds three subroutines:  C<parrot_version()>, C<slurp_file>, 
    16 and C<generated_file_header>. Subroutines are not exported--each must be 
    17 requested by using a fully qualified name. 
     15This package holds pre-configure time subroutines, which are not exported 
     16and should not require Parrot::Config. 
     17Each must be requested by using a fully qualified name. 
    1818 
    1919=head1 SUBROUTINES 
    2020 
     
    134134    return $header; 
    135135} 
    136136 
    137 1; 
     137=item C<generate_pbc_fingerprint()> 
    138138 
    139 =back 
     139Generate a unique number, the md5 of either the given arguments or 
     140of the non-commented lines of F<PBC_COMPAT>, for each pbc format change. 
     141 
     142This is used in the packfile library. 
     143See also F<tools/dev/pbc_header.pl> 
     144 
     145=cut 
     146 
     147sub generate_pbc_fingerprint { 
     148 
     149    unless (eval { require Digest::MD5; }) { 
     150        warn "Digest::MD5 not found. Skipping fingerprint"; 
     151        return ''; 
     152    } 
     153    my $uuid; 
     154    if (@_) { 
     155        $uuid = Digest::MD5::md5_base64(join " ", @_); 
     156    } 
     157    else { 
     158        my $content = slurp_file('PBC_COMPAT'); 
     159        $content =~ s/^#.*\n//gm; 
     160        $content =~ s/^\n//gm; 
     161        $uuid = Digest::MD5::md5_base64($content); 
     162    } 
     163    return substr $uuid, 0, 22; 
     164} 
     165 
     166=item C<get_bc_version()> 
     167 
     168Return an array of ($bc_major, $bc_minor) from F<PBC_COMPAT>. 
     169This is used to generate the pbc_uuid. 
    140170 
    141 =head1 AUTHOR 
     171See also F<tools/dev/pbc_header.pl> and F<tools/build/pbcversion_h.pl>. 
    142172 
    143 Gregor N. Purdy.  Revised by James E Keenan. 
     173=cut 
     174 
     175sub get_bc_version { 
     176    my $compat_file = 'PBC_COMPAT'; 
     177    my ( $bc_major, $bc_minor ); 
     178    open my $IN, '<', $compat_file or die "Can't read $compat_file"; 
     179    while (<$IN>) { 
     180        if (/^(\d+)\.0*(\d+)/) { 
     181            ( $bc_major, $bc_minor ) = ( $1, $2 ); 
     182            last; 
     183        } 
     184    } 
     185    unless ( defined $bc_major && defined $bc_minor ) { 
     186        die "No bytecode version found in '$compat_file'."; 
     187    } 
     188    close $IN; 
     189    return ( $bc_major, $bc_minor ); 
     190} 
     191 
     192 
     1931; 
     194 
     195=back 
    144196 
    145197=cut 
    146198 
  • tools/dev/pbc_header.pl

    old new  
    3636=cut 
    3737 
    3838use Getopt::Long; 
    39 use Digest::MD5 qw(md5); 
     39use lib "lib"; 
     40use Parrot::BuildUtil; 
    4041 
    4142my %opt; 
    42 use constant FP_LEN => 12; 
    43 my $word_size = 4; 
     43my $word_size = 4; # fixed and not opcode_t_size ! 
    4444 
    4545main(); 
    4646 
    47 sub get_fp { 
    48  
    49     # s. also fingerprint_c.pl 
    50     my $compat_file = 'PBC_COMPAT'; 
    51     open my $IN, '<', $compat_file or die "Can't read $compat_file"; 
    52     my @lines = <$IN>; 
    53     close $IN; 
    54  
    55     my $len = FP_LEN; 
    56     my $fingerprint = md5 join "\n", grep { !/^#/ } @lines; 
    57  
    58     return substr $fingerprint, 0, $len; 
    59 } 
    60  
    61 sub get_version { 
    62     my $version_file = 'VERSION'; 
    63     open my $IN, '<', $version_file or die "Can't read $version_file"; 
    64     my $v = <$IN>; 
    65     close $IN; 
    66     $v =~ /^(\d+)\.(\d+).?(\d+)?/; 
    67     my ($major, $minor, $patch) = ($1, $2, $3 ? $3 : 0); 
    68     die "Can't read $version_file" unless defined $major; 
    69     return ( $major, $minor, $patch ); 
    70 } 
    71  
    72 sub get_bc_version { 
    73     my $compat_file = 'PBC_COMPAT'; 
    74     my ( $major, $minor ); 
    75     open my $IN, '<', $compat_file or die "Can't read $compat_file"; 
    76     while (<$IN>) { 
    77         if (/^(\d+)\.0*(\d+)/) { 
    78             ( $major, $minor ) = ( $1, $2 ); 
    79             last; 
    80         } 
    81     } 
    82     die "Can't read $compat_file" unless defined $major; 
    83     close $IN; 
    84     return ( $major, $minor ); 
    85 } 
    86  
    8747sub update_fp { 
    8848    my (@args) = @_; 
    8949 
    90     my $fp = get_fp(); 
    91     my ( $major, $minor, $patch ) = get_version(); 
    92     my ( $bc_major, $bc_minor ) = get_bc_version(); 
     50    my $fp = Parrot::BuildUtil::generate_pbc_fingerprint(); 
     51    my $fp_len = length $fp; 
     52    my ( $major, $minor, $patch ) = Parrot::BuildUtil::parrot_version(); 
     53    my ( $bc_major, $bc_minor ) = Parrot::BuildUtil::get_bc_version(); 
    9354    for my $f (@args) { 
    9455        my $b; 
    9556        open my $F, "+<", "$f" or die "Can't open $f: $!"; 
     
    10465        # uuid_type = 1, uuid_size = 10, uuid_data = $fp 
    10566        read $F, $b, 8; 
    10667        my ($type, $uuid_len) = unpack "cc", $b; 
    107         if ($type != 1 or $uuid_len != FP_LEN) { 
     68        if ($type != 1 or $uuid_len != $fp_len) { 
    10869            # if uuid_type was 0 or of different size copy the tail first 
    10970            my $leftover = (18 + $uuid_len) % 16; 
    11071            my $n = $leftover == 0 ? 0 : 16 - $leftover; 
    111             # we can skip the copy if there's enough room already (pad:14=>2) 
    112             goto SEEK if $n < FP_LEN; 
     72            # we can skip the copy if there's enough room already (pad: 14=>2) 
     73            goto SEEK if $n > $fp_len; 
    11374            my $dirstart = 18 + $uuid_len + $n; 
    11475            seek $F, $dirstart, 0;   # skip to dir 
    11576            my $size = -s $F; 
     
    11980        } 
    12081      SEEK: 
    12182        seek $F, 16, 0;   # back to pos 16: uuid_type, uuid_size 
    122         print $F pack "cc", 1, FP_LEN; 
     83        print $F pack "cc", 1, $fp_len; 
    12384        print $F $fp; 
    12485        close $F; 
    12586    } 
  • config/gen/config_h/config_h.in

    old new  
    9494#define PARROT_BYTEORDER        0x@byteorder@ 
    9595#define PARROT_BIGENDIAN        @bigendian@ 
    9696#define PARROT_PTR_ALIGNMENT    @ptr_alignment@ 
     97#define PARROT_PBC_UUID         "@pbc_uuid@" 
    9798 
    9899#define PARROT_LITTLEENDIAN     !(PARROT_BIGENDIAN) 
    99100 
  • src/packfile.c

    old new  
    981981                          : FLOATTYPE_12_NAME)); 
    982982    TRACE_PRINTF(("PackFile_unpack: Byteorder %d (%sendian).\n", 
    983983                  header->byteorder, header->byteorder ? "big " : "little-")); 
    984  
     984    TRACE_PRINTF(("PackFile_unpack: uuid_type=%d\n", header->uuid_type)); 
     985    TRACE_PRINTF(("PackFile_unpack: uuid_size=%d\n", header->uuid_size)); 
    985986    /* Check the UUID type is valid and, if needed, read a UUID. */ 
    986987    if (header->uuid_type == 0) { 
    987988        /* No UUID; fine, nothing more to do. */ 
    988989    } 
    989990    else if (header->uuid_type == 1) { 
    990991        /* Read in the UUID. We'll put it in a NULL-terminated string, just in 
    991          * case pepole use it that way. */ 
     992         * case people use it that way. */ 
    992993        header->uuid_data = (unsigned char *) 
    993994            mem_sys_allocate(header->uuid_size + 1); 
    994995 
    995         memcpy(header->uuid_data, packed + PACKFILE_HEADER_BYTES, 
    996             header->uuid_size); 
    997  
     996        memcpy(header->uuid_data, PARROT_PBC_UUID, header->uuid_size); 
    998997        /* NULL terminate */ 
    999998        header->uuid_data[header->uuid_size] = 0; 
     999        TRACE_PRINTF(("PackFile_unpack: uuid_data='%s'\n", header->uuid_data)); 
    10001000    } 
    10011001    else 
    10021002        /* Don't know this UUID type. */ 
     
    10091009    header_read_length += header_read_length % 16 ? 
    10101010        16 - header_read_length % 16 : 0; 
    10111011    cursor              = packed + (header_read_length / sizeof (opcode_t)); 
     1012    TRACE_PRINTF(("PackFile_unpack: pad=%d\n", 
     1013                  cursor - packed)); 
    10121014 
    10131015    /* Set what transforms we need to do when reading the rest of the file. */ 
    10141016    PackFile_assign_transforms(self); 
     
    12441246#    endif 
    12451247#  endif 
    12461248#endif 
     1249    if (strlen(PARROT_PBC_UUID)) { 
     1250        header->uuid_type = 1; 
     1251        header->uuid_size = strlen(PARROT_PBC_UUID); 
     1252        header->uuid_data = (unsigned char *)mem_sys_allocate(header->uuid_size + 1); 
     1253        memcpy(header->uuid_data, PARROT_PBC_UUID, header->uuid_size); 
     1254        /* NULL terminate */ 
     1255        header->uuid_data[header->uuid_size] = 0; 
     1256    } 
    12471257} 
    12481258 
    12491259 
     
    34823492    ep->type = type; 
    34833493    ep->name = name; 
    34843494 
    3485     if (PackFile_map_segments(interp, dir, find_fixup_iter, (void *) ep)); 
     3495    if (PackFile_map_segments(interp, dir, find_fixup_iter, (void *) ep)) 
    34863496        return ep; 
    34873497 
    34883498    return NULL; 
  • Configure.pl

    old new  
    6464# from Parrot::Configure::Data 
    6565$conf->options->set( %{$args} ); 
    6666# save the command-line for make reconfig 
    67 $conf->data->set(configure_args => @ARGV ? '"'.join("\" \"", map {qq($_)} @ARGV).'"' 
    68                                          : ''); 
     67$conf->data->set(configure_args => 
     68                 @ARGV ? '"'.join("\" \"", map {qq($_)} @ARGV).'"' 
     69                       : ''); 
    6970 
    7071# Log files created by Configure.pl in MANIFEST.configure.generated 
    7172$conf->{active_configuration} = 1; 
  • config/auto/pmc.pm

    old new  
    99 
    1010Asks the user to select which PMC files to include. 
    1111 
     12Generate a specific UUID for this selection then, 
     13for the default use the md5 of PBC_COMPAT. 
     14 
    1215=cut 
    1316 
    1417package auto::pmc; 
     
    2225use File::Spec::Functions qw/catfile/; 
    2326 
    2427use Parrot::Configure::Utils ':auto'; 
     28use Parrot::BuildUtil; 
    2529 
    2630sub _init { 
    2731    my $self = shift; 
     
    168172 
    169173    my @names = $self->order_pmcs_by_hierarchy( \%parents ); 
    170174 
     175    # Generate a specific UUID for user-defined pmc's and ops 
     176    # auto::ops runs before auto::pmc, so do it here. 
     177    my $pbc_uuid = ''; 
     178    if ($conf->options->get('pmc') or $conf->options->get('ops')) { 
     179        unless (eval { require Digest::MD5; }) { 
     180            warn "Digest::MD5 not found. Skipping fingerprint"; 
     181        } 
     182        else { 
     183            my ( $major, $minor ) = Parrot::BuildUtil::get_bc_version(); 
     184            my @sources = (@names, $major, $minor); 
     185            my $ops = $conf->data->get( 'ops' ); 
     186            push @sources, $ops if $ops; 
     187            $pbc_uuid = Parrot::BuildUtil::generate_pbc_fingerprint(@sources); 
     188        } 
     189    } 
     190    else { # use the default UUID. This requires PBC_COMPAT discipline 
     191        $pbc_uuid = Parrot::BuildUtil::generate_pbc_fingerprint(); 
     192    } 
     193 
    171194    $conf->data->set( 
    172195        pmc                  => $pmc_list, 
    173196        pmc_names            => join( ' ', @names ), 
     197        pbc_uuid             => $pbc_uuid, 
    174198        TEMP_pmc_o           => $TEMP_pmc_o, 
    175199        TEMP_pmc_build       => $TEMP_pmc_build, 
    176200        TEMP_pmc_classes_o   => $TEMP_pmc_classes_o, 
  • tools/build/pbcversion_h.pl

    old new  
    2121use warnings; 
    2222use strict; 
    2323use lib 'lib'; 
     24use Parrot::BuildUtil; 
    2425 
    25 my ( $major, $minor ); 
    26  
    27 my $compat_file = 'PBC_COMPAT'; 
    28 open my $IN, '<', $compat_file or die "Can't read $compat_file"; 
    29 while (<$IN>) { 
    30     if (/^(\d+)\.0*(\d+)/) { 
    31         ( $major, $minor ) = ( $1, $2 ); 
    32         last; 
    33     } 
    34 } 
    35 close $IN; 
    36  
    37 unless ( defined $major && defined $minor ) { 
    38     die "No bytecode version found in '$compat_file'."; 
    39 } 
     26my ( $major, $minor ) = Parrot::BuildUtil::get_bc_version(); 
    4027 
    4128print << "EOF"; 
    4229/* ex: set ro: 
    4330 * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
    4431 * 
    45  * This file is generated automatically from '$compat_file' 
     32 * This file is generated automatically from 'PBC_COMPAT' 
    4633 * by $0. 
    4734 * 
    4835 * Any changes made here will be lost! 
  • config/auto/ops.pm

    old new  
    99 
    1010Asks the user to select which ops files to include. 
    1111 
     12Generate a specific UUID for this selection in auto::pmc then. 
     13 
    1214=cut 
    1315 
    1416package auto::ops;