# New Ticket Created by J�rgen B�mmels
# Please include the string: [perl #18072]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=18072 >
A PackFile created with a diffrent version of core.ops leads to
strange not easy to find errors. Therefor a fingerprint of core.ops is
entered to the packfile.
The fingerprint of the core.ops file is generated out of signatures of
the operations (comments and implementation details dont contribute).
This is relativ easy, because the complete parsing of core.ops is done
in OpsFile.pm.
I implemented in a really hacky way: abusing the padding bytes. But
this way it can be implemented *now*. When the named segments are in,
the fingerprint will go to a segment on its own. (Now I can only use
10 bytes of the 16 byte MD5-Hash, but hey we don't want to make
cryptography).
bye
b.
-- attachment 1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/40500/32674/273ee1/fingerprint.diff
Index: MANIFEST
===================================================================
RCS file: /cvs/public/parrot/MANIFEST,v
retrieving revision 1.239
diff -u -r1.239 MANIFEST
--- MANIFEST 23 Oct 2002 05:33:39 -0000 1.239
+++ MANIFEST 24 Oct 2002 01:05:08 -0000
@@ -199,6 +199,7 @@
examples/pxs/PQt.C
examples/pxs/QtHelloWorld.pasm
exceptions.c
+fingerprint_c.pl
global_setup.c
hash.c
headers.c
Index: MANIFEST.SKIP
===================================================================
RCS file: /cvs/public/parrot/MANIFEST.SKIP,v
retrieving revision 1.6
diff -u -r1.6 MANIFEST.SKIP
--- MANIFEST.SKIP 4 Sep 2002 03:48:26 -0000 1.6
+++ MANIFEST.SKIP 24 Oct 2002 01:05:08 -0000
@@ -18,6 +18,8 @@
^core_ops\.c$
^core_ops_prederef\.c$
+^core_ops_cg\.c$
+^fingerprint\.c$
^lib/Parrot/Jit\.pm$
^lib/Parrot/PMC\.pm$
Index: fingerprint_c.pl
===================================================================
RCS file: fingerprint_c.pl
diff -N fingerprint_c.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ fingerprint_c.pl 24 Oct 2002 01:05:08 -0000
@@ -0,0 +1,74 @@
+#! perl -w
+
+use strict;
+use lib 'lib';
+use Digest::MD5 qw(md5_hex);
+use Data::Dumper;
+use Parrot::OpLib::core;
+
+my $len = 10;
+my $fingerprint = md5_hex join "\n", map {
+ join '_', $_->{NAME}, @{$_->{ARGS}}
+} @$Parrot::OpLib::core::ops;
+
+print << "EOF";
+/*
+ * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+ *
+ * This file is generated automatically from 'core.ops'
+ * by $0.
+ *
+ * Any changes made here will be lost!
+ *
+ */
+
+#include <string.h>
+#include <parrot/packfile.h>
+
+EOF
+
+if (-e 'DEVELOPING') {
+
+print "/* $fingerprint */\n";
+print "static const unsigned char fingerprint[] = {\n";
+for my $i (0..$len-1) {
+ print ' 0x', substr ($fingerprint, $i*2, 2), ",\n";
+}
+print "};\n";
+
+print << "EOF";
+
+int
+PackFile_check_fingerprint (void *cursor)
+{
+ return memcmp (cursor, fingerprint, $len) == 0;
+}
+
+size_t
+PackFile_write_fingerprint (void *cursor)
+{
+ memcpy (cursor, fingerprint, $len);
+ return $len;
+}
+EOF
+
+} else { # !DEVELOPING
+
+ print << 'EOF';
+/* fingerprint checking is only in enabled in development versions */
+
+int
+PackFile_check_fingerprint (void *cursor)
+{
+ return 1;
+}
+
+size_t
+PackFile_write_fingerprint (void *cursor)
+{
+ memset (cursor, 0, $len);
+ return $len;
+}
+EOF
+
+} # endif DEVELOPING
Index: assemble.pl
===================================================================
RCS file: /cvs/public/parrot/assemble.pl,v
retrieving revision 1.93
diff -u -r1.93 assemble.pl
--- assemble.pl 18 Oct 2002 21:18:33 -0000 1.93
+++ assemble.pl 24 Oct 2002 01:05:10 -0000
@@ -427,6 +427,7 @@
use Parrot::Types; # For pack_op()
use Parrot::OpLib::core;
use Parrot::Config;
+use Digest::MD5 qw(md5_hex);
=head2 Assembler class
@@ -828,6 +829,17 @@
=cut
+sub _fingerprint {
+ my $fingerprint = md5_hex join "\n", map {
+ join '_', $_->{NAME}, @{$_->{ARGS}}
+ } @$Parrot::OpLib::core::ops;
+ my @arr = ();
+ for my $i (0..9) {
+ push @arr, hex substr ($fingerprint, $i*2, 2);
+ }
+ return @arr;
+}
+
sub output_bytecode {
my $self = shift;
my $wordsize;
@@ -847,20 +859,7 @@
flags => 0x00, # unsigned char flags
floattype => 0x00, # unsigned char floattype
- pad => [
- 0x19, # unsigned char pad[0]
- 0x40, # unsigned char pad[1]
-
- 0xe4, # unsigned char pad[2]
- 0x73, # unsigned char pad[3]
- 0x09, # unsigned char pad[4]
- 0x08, # unsigned char pad[5]
-
- 0x00, # unsigned char pad[6]
- 0x00, # unsigned char pad[7]
- 0x00, # unsigned char pad[8]
- 0x00 # unsigned char pad[9]
- ],
+ pad => [ _fingerprint ],
magic => 0x0131_55a1, # opcode_t magic
opcodetype => 0x5045_524c, # opcode_t opcodetype
Index: packout.c
===================================================================
RCS file: /cvs/public/parrot/packout.c,v
retrieving revision 1.12
diff -u -r1.12 packout.c
--- packout.c 11 Oct 2002 01:46:31 -0000 1.12
+++ packout.c 24 Oct 2002 01:05:10 -0000
@@ -85,6 +85,9 @@
self->header->flags = 0;
self->header->floattype = 0;
+ /* write the fingerprint */
+ PackFile_write_fingerprint (self->header->pad);
+
/* Pack the header */
mem_sys_memcopy(cursor, self->header, PACKFILE_HEADER_BYTES);
cursor += PACKFILE_HEADER_BYTES / sizeof(opcode_t);
Index: packfile.c
===================================================================
RCS file: /cvs/public/parrot/packfile.c,v
retrieving revision 1.57
diff -u -r1.57 packfile.c
--- packfile.c 11 Oct 2002 01:46:31 -0000 1.57
+++ packfile.c 24 Oct 2002 01:05:11 -0000
@@ -333,6 +333,13 @@
*/
header->magic = PackFile_fetch_op(self, cursor++);
+ /* check the fingerprint */
+ if (!PackFile_check_fingerprint (header->pad)) {
+ PIO_eprintf(NULL, "PackFile_unpack: Bytecode not valid for this "
+ "interpreter\n");
+ return 0;
+ }
+
/*
* The magic and opcodetype fields are in native byteorder.
*/
Index: config/gen/makefiles/root.in
===================================================================
RCS file: /cvs/public/parrot/config/gen/makefiles/root.in,v
retrieving revision 1.46
diff -u -r1.46 root.in
--- config/gen/makefiles/root.in 21 Oct 2002 08:47:06 -0000 1.46
+++ config/gen/makefiles/root.in 24 Oct 2002 01:05:11 -0000
@@ -51,7 +51,7 @@
GEN_HEADERS = $(INC)/vtable.h $(INC)/oplib/core_ops.h \
$(INC)/oplib/core_ops_prederef.h
-GEN_SOURCES = core_ops.c core_ops_prederef.c
+GEN_SOURCES = core_ops.c core_ops_prederef.c fingerprint.c
GEN_MODULES = lib/Parrot/Jit.pm lib/Parrot/OpLib/core.pm
@@ -100,7 +100,7 @@
embed$(O) warnings$(O) ${cg_o} \
packout$(O) byteorder$(O) debug$(O) smallobject$(O) \
headers$(O) dod$(O) method_util$(O) \
- misc$(O) spf_render$(O) spf_vtable$(O)
+ misc$(O) spf_render$(O) spf_vtable$(O) fingerprint$(O)
O_FILES = $(INTERP_O_FILES) \
$(IO_O_FILES) \
@@ -265,8 +265,8 @@
# Parrot Dump
#
-#$(PDUMP) : pdump$(O) packfile$(O)
-# $(LINK) ${ld_out}$(PDUMP) $(LINKFLAGS) pdump$(O) packfile$(O) string$(O) chartype$(O) memory$(O) $(C_LIBS)
+$(PDUMP) : pdump$(O) packdump$(O) $(O_FILES) $(O_DIRS)
+ $(LINK) ${ld_out}$(PDUMP) pdump$(O) packdump$(O) $(LINKFLAGS) $(O_FILES) $(C_LIBS)
###############################################################################
@@ -279,6 +279,9 @@
lib/Parrot/OpLib/core.pm : $(OPS_FILES) ops2pm.pl lib/Parrot/OpsFile.pm lib/Parrot/Op.pm
$(PERL) ops2pm.pl $(OPS_FILES)
+
+fingerprint.c : fingerprint_c.pl lib/Parrot/OpLib/core.pm
+ $(PERL) fingerprint_c.pl > fingerprint.c
###############################################################################
#
Index: .cvsignore
===================================================================
RCS file: /cvs/public/parrot/.cvsignore,v
retrieving revision 1.22
diff -u -r1.22 .cvsignore
--- .cvsignore 23 Oct 2002 03:01:20 -0000 1.22
+++ .cvsignore 24 Oct 2002 01:12:17 -0000
@@ -5,6 +5,7 @@
core_ops.c
core_ops_prederef.c
disassemble
+fingerprint.c
libparrot.a
libparrot.def
Makefile
