Filename | /usr/local/lib/perl5/site_perl/mach/5.24/Razor2/Signature/Ephemeral.pm |
Statements | Executed 7 statements in 2.10ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 44µs | 52µs | BEGIN@4 | Razor2::Signature::Ephemeral::
1 | 1 | 1 | 21µs | 77µs | BEGIN@5 | Razor2::Signature::Ephemeral::
1 | 1 | 1 | 19µs | 95µs | BEGIN@6 | Razor2::Signature::Ephemeral::
0 | 0 | 0 | 0s | 0s | debug | Razor2::Signature::Ephemeral::
0 | 0 | 0 | 0s | 0s | encode_separator | Razor2::Signature::Ephemeral::
0 | 0 | 0 | 0s | 0s | hexdigest | Razor2::Signature::Ephemeral::
0 | 0 | 0 | 0s | 0s | new | Razor2::Signature::Ephemeral::
0 | 0 | 0 | 0s | 0s | picksection | Razor2::Signature::Ephemeral::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | #!/usr/local/bin/perl | ||||
2 | |||||
3 | package Razor2::Signature::Ephemeral; | ||||
4 | 2 | 54µs | 2 | 59µs | # spent 52µs (44+8) within Razor2::Signature::Ephemeral::BEGIN@4 which was called:
# once (44µs+8µs) by Razor2::Client::Engine::BEGIN@6 at line 4 # spent 52µs making 1 call to Razor2::Signature::Ephemeral::BEGIN@4
# spent 8µs making 1 call to strict::import |
5 | 2 | 52µs | 2 | 134µs | # spent 77µs (21+56) within Razor2::Signature::Ephemeral::BEGIN@5 which was called:
# once (21µs+56µs) by Razor2::Client::Engine::BEGIN@6 at line 5 # spent 77µs making 1 call to Razor2::Signature::Ephemeral::BEGIN@5
# spent 56µs making 1 call to Exporter::import |
6 | 2 | 1.99ms | 2 | 170µs | # spent 95µs (19+75) within Razor2::Signature::Ephemeral::BEGIN@6 which was called:
# once (19µs+75µs) by Razor2::Client::Engine::BEGIN@6 at line 6 # spent 95µs making 1 call to Razor2::Signature::Ephemeral::BEGIN@6
# spent 75µs making 1 call to Exporter::import |
7 | |||||
8 | sub new { | ||||
9 | |||||
10 | my ($class, %args) = @_; | ||||
11 | |||||
12 | my $self = bless { | ||||
13 | seed => $args{seed} || 42, | ||||
14 | separator => encode_separator($args{separator}) || encode_separator("10"), | ||||
15 | }, $class; | ||||
16 | $self; | ||||
17 | |||||
18 | } | ||||
19 | |||||
20 | |||||
21 | sub hexdigest { | ||||
22 | |||||
23 | my ($self, $content) = @_; | ||||
24 | |||||
25 | # Initialize PRNG with $seed | ||||
26 | srand($$self{seed}); | ||||
27 | |||||
28 | my @content = split /$$self{separator}/, $content; | ||||
29 | # $content =~ s/$$self{separator}//g; -- We don't do this anyore | ||||
30 | |||||
31 | # my $size = length($content); | ||||
32 | my $lines = scalar @content; | ||||
33 | |||||
34 | debug("\nNumber of lines: $lines"); | ||||
35 | |||||
36 | # Randomly choose relative locations and section sizes (in percent) | ||||
37 | my $sections = 6; | ||||
38 | my $ssize = 100/$sections; | ||||
39 | my @rel_lineno = map { rand($ssize) + ($_*$ssize) } 0 .. ($sections-1); | ||||
40 | my @lineno = map { int(($_ * $lines)/100) } @rel_lineno; | ||||
41 | |||||
42 | debug("Relative Line Numbers (in percent): @rel_lineno"); | ||||
43 | debug("Absolute Line Numbers: @lineno"); | ||||
44 | |||||
45 | my @rel_offset1 = map { rand(50) + ($_*50) } qw(0 1); | ||||
46 | my @rel_offset2 = map { rand(50) + ($_*50) } qw(0 1); | ||||
47 | |||||
48 | debug("Relative Offsets for section 1: @rel_offset1"); | ||||
49 | debug("Relative Offsets for section 2: @rel_offset2"); | ||||
50 | |||||
51 | my ($l1, $l2) = (0, 0); | ||||
52 | for ($lineno[1] .. $lineno[2]) { $l1 += length($content[$_]) if $content[$_]} | ||||
53 | for ($lineno[3] .. $lineno[4]) { $l2 += length($content[$_]) if $content[$_] } | ||||
54 | |||||
55 | debug("Length of the first section: $l1 bytes"); | ||||
56 | debug("Length of the second section: $l2 bytes"); | ||||
57 | |||||
58 | my @offset1 = map { int(($_ * $l1)/100) } @rel_offset1; | ||||
59 | my @offset2 = map { int(($_ * $l2)/100) } @rel_offset2; | ||||
60 | |||||
61 | debug("Chunk start/end positions in Section 1: @offset1 (length: " . ($offset1[1] - $offset1[0]) .") "); | ||||
62 | debug("Chunk start/end positions in Section 2: @offset2 (length: " . ($offset2[1] - $offset2[0]) .") "); | ||||
63 | |||||
64 | my $x = 0; | ||||
65 | my ($sc, $sl, $ec, $el) = (0,0,0,0); | ||||
66 | my $section1 = picksection( \@content, | ||||
67 | $lineno[1], $lineno[2], | ||||
68 | $offset1[0], $offset1[1] | ||||
69 | ); | ||||
70 | my $section2 = picksection( \@content, | ||||
71 | $lineno[3], $lineno[4], | ||||
72 | $offset2[0], $offset2[1] | ||||
73 | ); | ||||
74 | |||||
75 | debug("Section 1: $section1"); | ||||
76 | debug("Section 2: $section2"); | ||||
77 | |||||
78 | my $seclength = length($section1.$section2); | ||||
79 | |||||
80 | debug("Total length of stuff that will be hashed: $seclength"); | ||||
81 | |||||
82 | if ($section1 =~ /^\s+$/ && $section2 =~ /^\s+$/) { | ||||
83 | debug("Both sections were whitespace only!"); | ||||
84 | $section1 = ""; | ||||
85 | $section2 = ""; | ||||
86 | } | ||||
87 | |||||
88 | my $digest; | ||||
89 | my $ctx = Digest::SHA1->new; | ||||
90 | |||||
91 | if ($seclength > 128) { | ||||
92 | $ctx->add($section1); | ||||
93 | $ctx->add($section2); | ||||
94 | $digest = $ctx->hexdigest; | ||||
95 | } else { | ||||
96 | debug("Sections too small... reverting back to orginal content."); | ||||
97 | $ctx->add($content); | ||||
98 | $digest = $ctx->hexdigest; | ||||
99 | } | ||||
100 | |||||
101 | debug("Computed e-hash is $digest"); | ||||
102 | |||||
103 | return $digest; | ||||
104 | |||||
105 | |||||
106 | } | ||||
107 | |||||
108 | |||||
109 | sub picksection { | ||||
110 | |||||
111 | my ($content, $sline, $eline, $soffset, $eoffset) = @_; | ||||
112 | my $x = 0; | ||||
113 | my ($sc, $sl, $ec, $el) = (0,0,0,0); | ||||
114 | |||||
115 | for ($sline .. $eline) { | ||||
116 | next unless $content->[$_]; | ||||
117 | $x = $x + length($content->[$_]); | ||||
118 | if (($x > $soffset) && ($sc == 0)) { # we come here first time | ||||
119 | $sc = length($content->[$_]) - ($x - $soffset); # $x is greater than start | ||||
120 | $sl = $_; # offset | ||||
121 | } | ||||
122 | if ($x > $eoffset) { | ||||
123 | $ec = length($content->[$_]) - ($x - $eoffset); | ||||
124 | $el = $_; | ||||
125 | } | ||||
126 | last if $ec; | ||||
127 | } | ||||
128 | |||||
129 | $sc = 0 if $sc < 0; | ||||
130 | $ec = 0 if $ec < 0; # FIX! not verified to work correctly. | ||||
131 | |||||
132 | debug("Absolute chunk offsets: Line $sl charachter $sc to line $el character $ec"); | ||||
133 | |||||
134 | my $section = ""; | ||||
135 | |||||
136 | if ($sl == $el) { | ||||
137 | if ($content->[$sl]) { | ||||
138 | $section = substr ($content->[$sl], $sc, $ec - $sc + 1); | ||||
139 | } else { | ||||
140 | $section = ""; | ||||
141 | } | ||||
142 | } else { | ||||
143 | $section .= substr($content->[$sl], $sc); | ||||
144 | for ($sl+1 .. $el-1) { | ||||
145 | $section .= $content->[$_]; | ||||
146 | } | ||||
147 | $section .= substr($content->[$el], 0, $ec); | ||||
148 | } | ||||
149 | return $section; | ||||
150 | } | ||||
151 | |||||
152 | |||||
153 | sub encode_separator { | ||||
154 | |||||
155 | my ($self, $separator) = @_; | ||||
156 | my $rv; | ||||
157 | |||||
158 | unless (ref $self) { $separator = $self } | ||||
159 | my @chars = split/-/, $separator; | ||||
160 | push @chars, $separator unless scalar @chars; | ||||
161 | for (@chars) { $rv .= chr($_) } | ||||
162 | return $rv; | ||||
163 | |||||
164 | } | ||||
165 | |||||
166 | |||||
167 | sub debug { | ||||
168 | my $message = shift; | ||||
169 | # print "debug: $message\n"; | ||||
170 | #open TMP, ">>/tmp/ehash"; | ||||
171 | #print TMP "$message\n"; | ||||
172 | #close TMP; | ||||
173 | } | ||||
174 | |||||
175 | |||||
176 | 1 | 7µs | 1; | ||
177 |