Les fichiers mappés permettent de diffuser, à l’ensemble des machines interfaces, un panel de paramètres. Ces fichiers contiennent des données brutes extraites de la base, stockées en mémoire dans des structures C puis ces structures sont écrites directement dans un fichier. Les données peuvent aussi bien être du texte que des données numériques. Les données numériques peuvent être écrites différemment selon les architectures matérielles. Il existe deux méthodes pour enregistrer des données numériques (endianess). D’autre part, il faut déterminer les zones de données numériques dans le fichier afin de pouvoir l’utiliser d’une architecture à l’autre.
Le modèle pour l’ordre des octets pour les types natifs, tels que des nombres entiers, s’appelle l’endianess. Il y a seulement deux modèles, « big endian » et « little endian », ceux-ci décrivent comment doit apparaître l’octet situé à l’adresse la plus basse d’un nombre entier composé de plusieurs octets. Le big endian l’octet le plus significatif vient d’abord, et le little endian l’octet le moins significatif vient d’abord. Ce qui suit illustre la représentation physique de la mémoire chaque modèle pour le nombre entier 0×87654321 (Exprimé en hexadécimal sur 4 octets).
| Octet le plus significatif | Octet le moins significatif | ||
|---|---|---|---|
| 0×87 | 0×65 | 0×43 | 0×21 |
| Adresse la plus basse | Adresse la plus haute |
| Octet le plus significatif | Octet le moins significatif | ||
|---|---|---|---|
| 0×21 | 0×43 | 0×65 | 0×87 |
| Adresse la plus basse | Adresse la plus haute |
La conversion d’un modèle à un autre est assez simple. Il suffit d’inverser la position des octets.
La méthode la plus simple pour faire le tri entre le texte et les nombres dans le fichier est d’analyser les sources du programme qui ont généré le fichier. Ainsi on peut obtenir une sorte de squelette du fichier et connaître la position des zones numériques.
Avant de pouvoir convertir les fichiers, il faut en déterminer la structure. C’est pour cela que le processus de conversion comprend deux programmes. Un pour convertir les fichiers à partir du fichier squelette (pack.conf) et un autre pour générer le fichier squelette à partir des sources en C. Il sera nécessaire de régénérer ce fichier à chaque modification des structures ou des types qui définissent les FUNC et donc les fichiers FAC. L’emplacement du fichier squelette reste à déterminer.
Les fichiers FAC sont générés par la fonction Grp_funcfac0000. Les sources préprocessées du fichier grp_funcfac0000.pc contiennent l’ensemble des structures et type pour écrire les fichiers FAC. C’est à partir de ce fichier que l’on va pouvoir générer le fichier squelette.
A partir d’une liste de jetons lexicaux associée à une liste d’expression rationnelle un arbre syntaxique est construit. Ensuite cet arbre est parcourut pour en ressortir que les structures ; les types utilisateurs n’ont pas d’intérêt pour le cas présent. L’analyse syntaxique est vraiment sommaire, elle n’est prévue uniquement pour les cas suivants :
Les autres cas telle que les énumérations ou les unions ne sont pas supportées.
Le programme peut s’utiliser sur n’importe quelle machine possédant l’interpréteur Perl d’installé. La version de l’interpréteur, avec laquelle le programme à été développé, est la version 5.6.0. Aucun module Perl n’est nécessaire pour l’exécution. Il faut compter une minute de temps d’exécution, tout dépend de la taille du fichier source à analyser.
Le programme s’invoque de la manière suivante :
$ ./struct2pack.pl source.c > pack.conf
Le fichier généré contient les informations suivantes :
Par exemple, prenons la structure ci-dessous :
typedef struct{ TYPTVR typtvr; NUSNPM nusnpm; RASOEC rasoec; RASOCA rasoca; NBABAU nbabau; DATADH datadh; LGRECO lgreco; NBREFE nbrefe; LIRECL lirecl; LGRECL lgrecl; LIREFA lirefa; LGREFA lgrefa; SECACT secact; MRCLF1 mrclf1; MRCLF2 mrclf2; MRCLF2 mrclf3; MRCLF2 mrclf4; } CREANC; /* Structure d une occurrence de creancier */
Voici ça représentation dans le fichier généré :
#CREANC => #{
#CHAR #IDENTIFIER #'[' #CONSTANT #']' ( char typtvr [ 1 ] )
#INT #IDENTIFIER ( int nusnpm )
#CHAR #IDENTIFIER #'[' #CONSTANT #']' ( char rasoec [ 24 ] )
#CHAR #IDENTIFIER #'[' #CONSTANT #']' ( char rasoca [ 16 ] )
#SHORT #IDENTIFIER ( short nbabau )
#CHAR #IDENTIFIER #'[' #CONSTANT #']' ( char datadh [ 8 ] )
#SHORT #IDENTIFIER ( short lgreco )
#SHORT #IDENTIFIER ( short nbrefe )
#CHAR #IDENTIFIER #'[' #CONSTANT #']' ( char lirecl [ 11 ] )
#SHORT #IDENTIFIER ( short lgrecl )
#CHAR #IDENTIFIER #'[' #CONSTANT #']' ( char lirefa [ 11 ] )
#SHORT #IDENTIFIER ( short lgrefa )
#CHAR #IDENTIFIER #'[' #CONSTANT #']' ( char secact [ 1 ] )
#CHAR #IDENTIFIER #'[' #CONSTANT #']' ( char mrclf1 [ 39 ] )
#CHAR #IDENTIFIER #'[' #CONSTANT #']' ( char mrclf2 [ 39 ] )
#CHAR #IDENTIFIER #'[' #CONSTANT #']' ( char mrclf3 [ 39 ] )
#CHAR #IDENTIFIER #'[' #CONSTANT #']' ( char mrclf4 [ 39 ] )
#}
CREANC => c1ic24c16sc8ssc11sc11sc1c39c39c39c39
En cas de modifications d’une structure dans les sources, suite à une nouvelle génération du fichier pack.conf, il faut toujours vérifier si les changements ont été reportés. La transcription des structures en types natifs sous forme d’une structure en C, n’est présente dans le fichier qu’à des fins de debuggage ou pédagogique. L’autre forme celle d’une chaîne de caractères, sera la seule utilisée par la suite, celle-ci est imitée du fonctionnement de la fonction pack en Perl. Pour une information exhaustive consulter la documentation Perl de cette fonction (perldoc –f pack).
Voici un tableau de correspondances entre les deux formes de transcription :
| pack | Description |
|---|---|
| c | Un caractère |
| s | Un short signé |
| i | Un integer signé |
| c27 | Un tableau de 27 caractéres |
| l | Un long signé |
| d | Un double |
| f | Un float |
Les espaces dans la chaîne sont utilisés pour contrôler l’alignement des structures.
Les informations obtenues suite à l’analyse du code source permettent de connaître précisément l’emplacement des zones numériques à convertir.
A partir du fichier pack.conf, le programme effectue une recherche sur le squelette souhaité. Ensuite fichier binaire FAC est chargé en mémoire en fonction du squelette. Les alignements mémoires sont réalisés au chargement du fichier. Les zones numériques sont ensuite converties puis le fichier est écrit. La méthode de conversion ne tient pas compte de l’environnement d’exécution, ni du format d’entrée ou de sortie. Si les zones numériques du fichier d’entrée sont en « big endian », le fichier de sortie sera en « little endian » et vice versa.
Le programme peut s’utiliser sur n’importe quelle machine possédant l’interpréteur Perl d’installé. La version de l’interpréteur, avec laquelle le programme à été développé, est la version 5.6.0 (/usr/bin/perl en général). Aucun module Perl n’est nécessaire pour l’exécution. Le temps d’exécution est assez court.
Le programme s’invoque de la manière suivante :
$ ./fac_endian_conv.plwrong argument not fac number at ./fac_endian_conv.pl line 93.
Le nom de la structure, qui définie le fichier à convertir, doit être spécifié. En cas d’ambiguïté le programme fera des suggestions approchantes
$ ./fac_endian_conv.pl FAC0005search for FAC0005ambiguious fac name. Please pick one:GRP_FUNCFAC0005_REP, GRP_FUNCFAC0005_REQ, GRP_TXFAC0005_REP
Une fois le bon nom de structure choisi, il suffit de préciser le nom du fichier d’entrée et celui de sortie.
$ ./fac_endian_conv.pl GRP_FUNCFAC0005_REP FAC0005.in FAC0005.outsearch for GRP_FUNCFAC0005_REPFAC0005.out written
Le programme printpack.pl permet d’afficher à l’écran un fichier FAC affin d’en vérifier le contenu. Il s’utilise de la même manière que le programme fac_endian_conv.pl sans préciser le fichier de sortie. Voici un échantillon de la sortie écran :
$ ./printpack.pl GRP_FUNCFAC0005_REP FAC0005.insearch for GRP_FUNCFAC0005_REP
…skipping…
a20 0 0( 20) => [(AB2_DATE )]20
a5 1 20( 5) => [( )]5
a18 2 25( 18) => [( )]18
a64 3 43( 64) => [(LibellM-i dynamique titulaire )]64
pad a5 4 107( -5) => [()]5 d 5 112( 8) => [(0)]8
s 6 120( 2) => [(7){0x0007}]2
a40 7 122( 40) => [(nM-i le : )]40
pad a6 8 162( -6) => [()]6
a20 9 168( 20) => [(AB2_DEPT )]20
a5 10 188( 5) => [( )]5
a18 11 193( 18) => [( )]18
a64 12 211( 64) => [(LibellM-i dynamique titulaire )]64
pad a5 13 275( -5) => [()]5
d 14 280( 8) => [(0)]8
s 15 288( 2) => [(6){0x0006}]2
a40 16 290( 40) => [(Dept : )]40
pad a6 17 330( -6) => [()]6
…skipping…
Voici la même opération sur le fichier de sortie :
$ ./printpack.pl GRP_FUNCFAC0005_REP FAC0005.outsearch for GRP_FUNCFAC0005_REP
…skipping…
a20 0 0( 20) => [(AB2_DATE )]20
a5 1 20( 5) => [( )]5
a18 2 25( 18) => [( )]18
a64 3 43( 64) => [(LibellM-i dynamique titulaire )]64
pad a5 4 107( -5) => [()]5 d 5 112( 8) => [(0)]8
s 6 120( 2) => [(1792){0x0700}]2
a40 7 122( 40) => [(nM-i le : )]40
pad a6 8 162( -6) => [()]6
a20 9 168( 20) => [(AB2_DEPT )]20
a5 10 188( 5) => [( )]5
a18 11 193( 18) => [( )]18
a64 12 211( 64) => [(LibellM-i dynamique titulaire )]64
pad a5 13 275( -5) => [()]5
d 14 280( 8) => [(0)]8
s 15 288( 2) => [(1536){0x0600}]2
a40 16 290( 40) => [(Dept : )]40
pad a6 17 330( -6) => [()]6
…skipping…
On peut ainsi vérifier que la conversion, sur les zones numériques, a bien été effectuée.
#!/usr/bin/perl -w use strict; # # Ce script analyse un fichier en C. # Le but est d'analyser les types et les structures pour pouvoir determiner # la composition, de ces structures, en types primaires. # # # Tableau d'expressions regulieres et de jetons lexicaux # my @tokens = ( ["\\s+" , "" ], ["\\#.*\$" , "" ], ["//.*" , "" ], ["\".*\"" , "STRING_LITERAL"], ["'.'" , "CHAR_LITERAL" ], ["\Q->\E" , "PTR_OP" ], ["\Q\.\E" , "STRUCT_OP" ], ["\Q++\E" , "INC_OP" ], ["\Q--\E" , "DEC_OP" ], ["\Q<<\E" , "LEFT_OP" ], ["\Q>>\E" , "RIGHT_OP" ], ["\Q<=\E" , "LE_OP" ], ["\Q>=\E" , "GE_OP" ], ["\Q==\E" , "EQ_OP" ], ["\Q!=\E" , "NE_OP" ], ["\Q&&\E" , "AND_OP" ], ["\Q||\E" , "OR_OP" ], ["\Q*=\E" , "MUL_ASSIGN" ], ["\Q/=\E" , "DIV_ASSIGN" ], ["\Q%=\E" , "MOD_ASSIGN" ], ["\Q+=\E" , "ADD_ASSIGN" ], ["\Q-=\E" , "SUB_ASSIGN" ], ["\Q<<=\E" , "LEFT_ASSIGN" ], ["\Q>>=\E" , "RIGHT_ASSIGN" ], ["\Q&=\E" , "AND_ASSIGN" ], ["\Q~=\E" , "XOR_ASSIGN" ], ["\Q|=\E" , "OR_ASSIGN" ], ["extern(?=\\s)" , "EXTERN" ], ["static(?=\\s)" , "STATIC" ], ["auto(?=\\s)" , "AUTO" ], ["register(?=\\s)" , "REGISTER" ], ["char(?=(\\s|\\*))" , "CHAR" , 'c' ], ["short(?=(\\s|\\*))" , "SHORT" , 's' ], ["int(?=(\\s|\\*))" , "INT" , 'i' ], ["long(?=(\\s|\\*))" , "LONG" , 'l' ], ["signed(?=\\s)" , "SIGNED" , 1 ], ["unsigned(?=\\s)" , "UNSIGNED" , -1 ], ["float(?=(\\s|\\*))" , "FLOAT" , 'f' ], ["double(?=(\\s|\\*))" , "DOUBLE" , 'd' ], ["const(?=\\s)" , "CONST" ], ["volatile(?=\\s)" , "VOLATILE" ], ["void(?=(\\s|\\*))" , "VOID" ], ["typedef(?=\\s)" , "TYPEDEF" ], # ["struct(?=(\\s|{))" , "STRUCT" ], ["struct" , "STRUCT" ], ["union(?=(\\s|{))" , "UNION" ], ["enum(?=(\\s|{))" , "ENUM" ], ["\Q...\E" , "ELIPSIS" ], ["case(?=(\\s|:))" , "CASE" ], ["default(?=(\\s|:))" , "DEFAULT" ], ["if(?=(\\s|\\())" , "IF" ], ["else(?=(\\s|{))" , "ELSE" ], ["switch(?=(\\s|\\())" , "SWITCH" ], ["while(?=(\\s|\\())" , "WHILE" ], ["do(?=(\\s|\\())" , "DO" ], ["for(?=(\\s|\\())" , "FOR" ], ["goto(?=(\\s|\\())" , "GOTO" ], ["continue(?=(\\s|;))" , "CONTINUE" ], ["break(?=(\\s|;))" , "BREAK" ], ["return(?=(\\s|;|\\())" , "RETURN" ], ["inline(?=\\s)" , "INLINE" ], ["sizeof(?=(\\s|\\())" , "SIZEOF" ], [";" , "';'" ], [":" , "':'" ], ["\\?" , "'?'" ], ["\\[" , "'['" ], ["\\]" , "']'" ], ["\\{" , "'{'" ], ["\\}" , "'}'" ], ["\\(" , "'('" ], ["\\)" , "')'" ], ["\\*" , "'*'" ], ["/" , "'/'" ], ["\\+" , "'+'" ], ["-" , "'-'" ], ["=" , "'='" ], ["," , "','" ], ["!" , "'!'" ], ["%" , "'%'" ], ["<" , "'<'" ], [">" , "'>'" ], ["&" , "'&'" ], ["(0[xX][0-9a-fA-F]+)|(0[0-7]*)|([0-9]+)" , "CONSTANT" ], ["[_a-zA-Z][_a-zA-Z0-9]*" , "IDENTIFIER" ] ); # # Fonction d'analyse lexicale # sub token_match { foreach my $token (@tokens) { $_ =~ /^($token->[0])/ or next; length($token->[1]) and token_buildstack($token->[1], $&, $token->[2]); $_ = $'; return (1); } return (0); } my $token_tree = {}; my $token_stack = []; my $typedef_state = 0; $SIG{INT} = sub { print "INT\n"; &printtree(); exit -1 }; sub token_buildstack { my $token = [@_]; $typedef_state = 1 if $token->[0] eq "TYPEDEF"; push @$token_stack, $token if $typedef_state; if (scalar @$token_stack > 3) { if ($token_stack->[0]->[0] eq "TYPEDEF" && $token_stack->[-1]->[0] eq "';'") { if (token_buildtree()) { $token_stack = []; $typedef_state = 0; } return (1); } } return (0); } sub resolve_types { my ($list) = @_; my $types = []; my $tricks = []; foreach my $tok (@$list) { push @$tricks, $tok; if ($tok->[0] eq "';'") { push @$types, $tricks; $tricks = []; next; } } my $search = 0; map {$search++ if $_->[0]->[0] eq "IDENTIFIER" } @$types; return $list unless $search; foreach my $type (@$types) { if ($type->[0]->[0] eq "IDENTIFIER") { if (defined $token_tree->{$type->[0]->[1]}) { # typdef simple (redefinition d'un type primaire if (ref $token_tree->{$type->[0]->[1]} eq 'ARRAY') { my $tab = $token_tree->{$type->[0]->[1]}; $type->[0] = $tab->[0]; next unless defined $tab->[1]->[0] and defined $tab->[2]->[0] and defined $tab->[3]->[0]; # insertion des multiplicateur entre l'identifier et le ';' if ($tab->[1]->[0] eq "'['" and $tab->[2]->[0] eq "CONSTANT" and $tab->[3]->[0] eq "']'") { my $last = pop @$type; push @$type, @$tab[1,2,3], $last; } } # typedef struct (cas d'un type elementaire) if (ref $token_tree->{$type->[0]->[1]} eq 'HASH') { $type->[0]->[0] = $token_tree->{$type->[0]->[1]}->{list}; } } } } $list = []; foreach my $type (@$types) { push @$list, @$type; } return $list; } sub token_buildtree { #pointeur sur fonction... pas une super gestion... if ($token_stack->[-2]->[0] eq "')'") { return 1; } #enum if ($token_stack->[1]->[0] eq "ENUM") { return 1; } #union if ($token_stack->[1]->[0] eq "UNION") { return 1; } #volatile if ($token_stack->[1]->[0] eq "VOLATILE") { splice @$token_stack, 1, 1; } #type adjectif if (scalar @$token_stack == 5 && $token_stack->[3]->[0] eq "IDENTIFIER" && $token_stack->[1]->[0] ne "IDENTIFIER" && $token_stack->[1]->[0] ne "STRUCT" && $token_stack->[2]->[0] ne "IDENTIFIER") { $token_tree->{$token_stack->[-2]->[1]} = [$token_stack->[1], $token_stack->[2]]; return 1; } #type simple if (scalar @$token_stack == 4 && $token_stack->[2]->[0] eq "IDENTIFIER") { $token_tree->{$token_stack->[-2]->[1]} = [$token_stack->[1]]; return 1; } #tableau if ($token_stack->[-2]->[0] eq "']'" && $token_stack->[-3]->[0] eq "CONSTANT" && $token_stack->[-4]->[0] eq "'['" && $token_stack->[-5]->[0] eq "IDENTIFIER" && $token_stack->[1]->[0] ne "STRUCT") { my @type = @$token_stack; splice @type, 0, 1; splice @type, -5, 1; splice @type, -1, 1; $token_tree->{$token_stack->[-5]->[1]} = \@type; return 1; } #structure complete ? if ($token_stack->[1]->[0] eq "STRUCT") { my $brace_left = 0; my $brace_right = 0; map { $brace_left++ if $_->[0] eq "'{'"; $brace_right++ if $_->[0] eq "'}'"; } @$token_stack; return (0) unless $brace_left == $brace_right; my $types = []; #structure anonyme ? if ($token_stack->[2]->[0] eq "IDENTIFIER" && $token_stack->[3]->[0] eq "'{'") { splice @$token_stack, 2, 1; } foreach my $tok (@$token_stack) { next if $tok->[0] eq "TYPEDEF"; next if $tok->[0] eq "STRUCT"; next if $tok->[0] eq "'{'"; last if $tok->[0] eq "'}'"; push @$types, $tok; } $types = resolve_types($types); $token_tree->{$token_stack->[-2]->[1]}->{list} = $types; return (1); } printtypes($token_stack); &printtree(); die; return (0); } # # Fonction d'affichage (En grande partie pour le debug) # sub printtree { my @list = @_; @list = keys %$token_tree unless scalar @list; foreach my $k (@list) { next if (ref $token_tree->{$k} eq "ARRAY"); print '#', $k, ' => '; if (ref $token_tree->{$k} eq "ARRAY") { printtypes($token_tree->{$k}); } if (ref $token_tree->{$k} eq "HASH") { printstruct($token_tree->{$k}->{list}); } print "\n"; } } sub printstruct { my $list = shift; my $level = shift || 0; my @tricks = (); print '#', " "x$level; print "{\n"; foreach my $tok (@$list) { if ($tok->[0] eq "';'") { print join(' ', '(', @tricks, ')'), "\n"; @tricks = (); next; } if (ref $tok->[0] eq 'ARRAY') { printstruct($tok->[0], $level + 1); } else { print '#', " "x$level; print $tok->[0], " "; } push @tricks, $tok->[1]; } print '#', " "x$level; print "} "; print "\n" unless $level; } sub printtypes { my ($list) = @_; foreach my $tok (@$list) { if (ref $tok->[0] eq 'ARRAY') { print "#\t{\n"; printtypes($tok->[0]); print "#\t}\n"; next; } print '#', $tok->[0], " "; } print "("; foreach my $tok (@$list) { print $tok->[1], " "; } print ")"; } # # Fonction de generation des packs des structures # sub packtree { my @list = @_; @list = keys %$token_tree unless scalar @list; foreach my $k (@list) { next if (ref $token_tree->{$k} eq "ARRAY"); printtree($k); print $k, ' => '; if (ref $token_tree->{$k} eq "ARRAY") { print packtypes($token_tree->{$k}); } if (ref $token_tree->{$k} eq "HASH") { print packstruct($token_tree->{$k}->{list}); } print "\n\n\n"; } } sub factopack { my ($str) = @_; $_ = $str; my $last_char = ''; my @out = (); my $i = 0; while (/./) { if ($& eq $last_char) { $i++; } else { $last_char .= ++$i if $i; push @out, $last_char; $last_char = $&; $i = 0; } $_ = $'; } return join ('', @out); } sub packstruct { my $list = shift; my $level = shift || 0; my @out = (); my @tricks = (); my $unsigned = 0; my $multi = 1; my $multi_state = 0; foreach my $tok (@$list) { if ($tok->[0] eq "';'") { my $val = join ('', @tricks); if ($multi_state == 3) { if (length $val == 1) { push @out, "$val$multi"; } else { push @out, " $val" x $multi; } $multi_state = 0; $multi = 1; } else { push @out, $val; } @tricks = (); next; } $multi_state = 1 if ($tok->[0] eq "'['"); if ($tok->[0] eq 'CONSTANT' && $multi_state == 1) { $multi_state = 2; $multi *= $tok->[1]; } $multi_state = 3 if ($tok->[0] eq "']'" && $multi_state == 2); if (ref $tok->[0] eq 'ARRAY') { push @tricks, packstruct($tok->[0], $level + 1); } if (defined $tok->[2]) { if ($tok->[0] eq 'UNSIGNED') { $unsigned = 1; next } if ($unsigned == 1) { $unsigned = 0; push @tricks, uc($tok->[2]); next } push @tricks, $tok->[2]; } } return @out; } sub packtypes { my ($list) = @_; my @out = (); my $unsigned = 0; foreach my $tok (@$list) { if (defined $tok->[2]) { if ($tok->[0] eq 'UNSIGNED') { $unsigned = 1; next; } if ($unsigned == 1) { $unsigned = 0; push @out, uc($tok->[2]); next } push @out, $tok->[2]; } } return @out; } # # Corps principal du programme # open(CPP, "cpp -I/usr/include " . (defined($ARGV[0]) ? "$ARGV[0]" : "") . "|") or die (defined($ARGV[0]) ? "$ARGV[0]" : "STDIN", ": $!\n"); while (<CPP>) { chomp(); while (length($_)) { token_match() or die ("Parse ERROR on $_"); } } close CPP; print "\n"; &packtree();
#!/usr/bin/perl -w use strict; my @align = (); sub pad($$;$) { my ($val, $res, $noalign) = @_; my $tot = 0; map {$tot += abs} @align; $tot = $tot % $val; if ($tot) { $tot = $val - $tot; push @$res, $tot == 1 ? 'a' : 'a' . $tot ; push @align, -($tot); } push @align, $val unless defined $noalign; } sub splitpack { my $str = shift; my @res = (); @align = (); while ($str) { if ($str =~ /^(.)(\d*)/) { if ($1 eq 'c' and defined $2) { push @res, 'a' . $2; push @align, $2 eq '' ? 1 : $2; } else { push @align, 1 if ($1 eq 'c'); push @align, 1 if ($1 eq 'X'); push @align, 1 if ($1 eq 'x'); if ($1 eq 's') { pad(2, \@res); } if ($1 eq 'i') { pad(4, \@res); } if ($1 eq 'd') { pad(8, \@res); } push @align, 4 if ($1 eq 'f'); if ($1 eq ' ') { pad(8, \@res, 0); $align[-1] = -$align[-1] unless length $'; } else { push @res, $&; } } $str = $'; } } return @res; } sub subalign() { my $i = -1; my $result = 0; while ($align[$i] < 0) { $result += abs($align[$i]); $i--; } return $result; } sub convert_endian { my ($pack, $data) = @_; my $pdata; if (length $data) { $pdata = pack($pack, $data); } else { $pdata = pack($pack, 0); } my $len = (length $pdata) / 2; my @d = unpack('n ' x $len, $pdata); my $dout = pack('v ' x $len, reverse @d); return unpack($pack, $dout); } my $conf = {}; open CONF, "pack.conf" or die; while (<CONF>) { chomp; next if (/^$/); next if (/^#/); my ($struct_name, $pack) = split ' => '; $conf->{$struct_name} = $pack; } close CONF; my $fac = shift || die "wrong argument not fac number"; my $result = []; print "search for $fac\n"; foreach my $k (keys %{$conf}) { if ($k =~ /$fac/o) { push @$result, $k; } } if (scalar @$result gt 1) { print "ambiguious fac name. Please pick one:\n"; print join(', ', @$result), "\n"; exit (-1); } my $fac_pack = $conf->{$fac}; print "$conf->{$fac}\n"; undef $conf; #save some memory space. #$fac_pack =~ s/d/i/g; #$fac_pack =~ s/s/i/g; my @data = (); open FILEFAC, shift or die; my $save = $/; $/ = undef; my $data_fac = <FILEFAC>; $/ = $save; close FILEFAC; $fac_pack = substr($fac_pack, 6); #Control FUNC my $org_datalength = length($data_fac); print "length data: ", $org_datalength, "\n"; my @packs = splitpack("$fac_pack "); print join(' ', @packs), "\n"; #print join(' ', @align), "\n"; #splice(@packs, 0, 5); #degagage de l'entete GRP_FUNC #splice(@align, 0, 5); #degagage de l'entete GRP_FUNC my @test = @packs; #$data_fac = "\000" x 12 . $data_fac; my $totalpack = 0; map {$totalpack += abs} @align; printf("totalpack : %d[%x]\n", $totalpack, $totalpack); my $offset = $totalpack - subalign(); $offset = $offset + ($offset % 8); print "offset: $offset\n"; while ($data_fac) { my $d = []; @$d = unpack(join(' ', @packs), $data_fac); if (length($data_fac) > $totalpack) { $data_fac = substr($data_fac, $offset); } else { $data_fac = ''; } push @data, @$d; } my $i = 0; my $align_total = 0; $i = 0; $align_total = 0; foreach my $d (@data) { last if $align_total >= $org_datalength; unless ($i % scalar @test) { print '-'x70, "\n"; } printf("%5s %5s %5d %5d(%5d) => [", $align[$i % scalar @align] <= 0 ? "pad" : "", $test[$i % scalar @test], $i, $align_total, $align[$i % scalar @align]); $align_total += abs($align[$i % scalar @align]); if ($test[$i % scalar @test] eq 'c') { print chr($d); } elsif ($test[$i % scalar @test] eq 's') { printf("(%d){0x%.4x}", $d, $d); } else { print "($d)"; } print "]", length(pack($test[$i % scalar @test], length $d ? $d : 0)), "\n"; $i++; }
#!/usr/bin/perl -w use strict; # Tableau global -> Contient la liste des tailles des types + les alignements my @align = (); # # Fonction de pading pour calculer l'alignement necessaire. # sub pad($$;$) { my ($val, $res, $noalign) = @_; my $tot = 0; map {$tot += abs} @align; $tot = $tot % $val; if ($tot) { $tot = $val - $tot; push @$res, $tot == 1 ? 'a' : 'a' . $tot ; push @align, -($tot); } push @align, $val unless defined $noalign; } # # Fonction d'analyse du packs # ## ## Il faut determiner le type de donnees pour en deduire l'alignement a ## appliquer. (toujours des doutes sur les long. ## sub splitpack { my $str = shift; my @res = (); @align = (); while ($str) { if ($str =~ /^(.)(\d*)/) { if ($1 eq 'c' and defined $2) { push @res, 'a' . $2; push @align, $2 eq '' ? 1 : $2; } else { push @align, 1 if ($1 eq 'c'); push @align, 1 if ($1 eq 'X'); push @align, 1 if ($1 eq 'x'); if ($1 eq 's') { pad(2, \@res); } if ($1 eq 'i') { pad(4, \@res); } if ($1 eq 'd') { pad(8, \@res); } push @align, 4 if ($1 eq 'f'); if ($1 eq ' ') { pad(8, \@res, 0); $align[-1] = -$align[-1] unless length $'; } else { push @res, $&; } } $str = $'; } } return @res; } # # Fonction d'alignement des structures. # sub subalign() { my $i = -1; my $result = 0; while ($align[$i] < 0) { $result += abs($align[$i]); $i--; } return $result; } # # Fonction de endian conversion. # sub convert_endian { my ($pack, $data) = @_; my $pdata; if (length $data) { #Juste pour le warning $pdata = pack($pack, $data); } else { $pdata = pack($pack, 0); } my $len = (length $pdata) / 2; my @d = unpack('n ' x $len, $pdata); my $dout = pack('v ' x $len, reverse @d); return unpack($pack, $dout); } # # Lecture de la configuration # ## ## Le fichier pack.conf contient la definition des strutures a lire ## a fin de pouvoir les convertir. ## my $conf = {}; open CONF, "pack.conf" or die; while (<CONF>) { chomp; next if (/^$/); next if (/^#/); my ($struct_name, $pack) = split ' => '; $conf->{$struct_name} = $pack; } close CONF; # # Gestion des arguments # my $fac = shift || die "wrong argument not fac number"; my $fac_file = shift; my $out_file = shift; my $result = []; print "search for $fac\n"; foreach my $k (keys %{$conf}) { if ($k =~ /$fac/o) { push @$result, $k; } } if (scalar @$result gt 1) { print "ambiguious fac name. Please pick one:\n"; print join(', ', @$result), "\n"; exit (-1); } # # Chargement en memoire du fichier FAC a convertir # my $fac_pack = $conf->{$fac}; undef $conf; #save some memory space. my @data = (); open FILEFAC, $fac_file or die; my $save = $/; $/ = undef; my $data_fac = <FILEFAC>; $/ = $save; close FILEFAC; # # Preparation des donnees generales (Taille de fichier, offset, etc...) # $fac_pack = substr($fac_pack, 6); #Decalage #Variable global -> Contient la taille du fichier lu my $org_datalength = length($data_fac); #Tableau global -> Contient la liste des packs + alignements my @packs = splitpack("$fac_pack "); my $totalpack = 0; map {$totalpack += abs} @align; my $offset = $totalpack - subalign(); $offset = $offset + ($offset % 8); # # Decomposition du fichier de donnees en fonction des packs pour # constituer un tableau pour effectuer les endians conversions. # while ($data_fac) { my $d = []; @$d = unpack(join(' ', @packs), $data_fac); if (length($data_fac) > $totalpack) { $data_fac = substr($data_fac, $offset); } else { $data_fac = ''; } push @data, @$d; } # # Conversion des donnees numeriques (uniquement) Pas de gestion du float. # J'ai des doutes pour le long. # my $i = 0; my $align_total = 0; foreach my $d (@data) { if ($packs[$i % scalar @packs] eq 's') { $d = convert_endian('s', $d); } if ($packs[$i % scalar @packs] eq 'i') { $d = convert_endian('i', $d); } if ($packs[$i % scalar @packs] eq 'l') { $d = convert_endian('l', $d); } if ($packs[$i % scalar @packs] eq 'd') { $d = convert_endian('d', $d); } $i++; } # #Ecriture des donnees converties dans un fichier # $i = 0; $align_total = 0; open OUTFILE, ">$out_file" or die; foreach my $d (@data) { last if $align_total >= $org_datalength; $align_total += abs($align[$i % scalar @align]); print OUTFILE pack($packs[$i % scalar @packs], $d); $i++; } close OUTFILE; print "$out_file written\n";