line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Quantum::Usrn; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
8741
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
60
|
|
4
|
1
|
|
|
1
|
|
1056
|
use Crypt::Blowfish; |
|
1
|
|
|
|
|
1301
|
|
|
1
|
|
|
|
|
605
|
|
5
|
|
|
|
|
|
|
$Quantum::Usrn::VERSION = '1.00'; |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
my $key = pack('H*', q{4d61727479205061756c6579203c6d61727479406b617365692e636f6d3e0a4a75737420416e6f74686572205065726c204861636b65720a}); |
8
|
|
|
|
|
|
|
my $cipher = Crypt::Blowfish->new($key); |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
sub _generate_noise { |
11
|
5
|
|
|
5
|
|
5
|
my $data = shift; |
12
|
5
|
|
|
|
|
59
|
my $x = pack('NN', rand(2**32), rand(2**32)); |
13
|
5
|
|
|
|
|
6
|
my $result = $x; |
14
|
5
|
100
|
66
|
|
|
28
|
if ((~$data & $data) eq 0 and $data==int $data) { |
15
|
4
|
|
|
|
|
22
|
$result .= $x = $cipher->encrypt($x ^ pack('a4N', 'srn#', int(rand(2**32)))); |
16
|
4
|
|
|
|
|
50
|
$result .= $x = $cipher->encrypt($x ^ pack('NN', $data, int(rand(2**32)))); |
17
|
|
|
|
|
|
|
} else { |
18
|
1
|
|
|
|
|
8
|
$result .= $x = $cipher->encrypt($x ^ pack('a4N', 'srn$', int(rand(2**32)))); |
19
|
1
|
|
|
|
|
14
|
foreach my $four ($data=~/.{1,4}/ogs) { |
20
|
6
|
|
|
|
|
41
|
$result .= $x = $cipher->encrypt($x ^ pack('a4N', $four, int(rand(2**32)))); |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
} |
23
|
5
|
|
|
|
|
41
|
return $result; |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub _filter_noise { |
27
|
10
|
|
|
10
|
|
11
|
my $data = shift; |
28
|
10
|
|
|
|
|
48
|
my ($x, $b0, @block) = $data=~/.{8}/ogs; |
29
|
10
|
100
|
|
|
|
22
|
return undef unless defined $b0; |
30
|
6
|
|
|
|
|
16
|
my ($type) = substr($x ^ $cipher->decrypt($b0), 0, 4) =~ /^srn([#\$])$/; |
31
|
6
|
|
|
|
|
55
|
$x = $b0; |
32
|
6
|
100
|
|
|
|
12
|
return undef unless defined $type; |
33
|
5
|
|
|
|
|
3
|
my $result; |
34
|
5
|
100
|
|
|
|
10
|
if ($type eq '#') { |
35
|
4
|
|
|
|
|
14
|
$result = (unpack('NN', $x ^ $cipher->decrypt($block[0])))[0]; |
36
|
|
|
|
|
|
|
} else { |
37
|
1
|
|
|
|
|
9
|
foreach my $block (@block) { |
38
|
6
|
|
|
|
|
13
|
my $txt = $x ^ $cipher->decrypt($block); |
39
|
6
|
|
|
|
|
32
|
$result .= substr($txt, 0, 4); |
40
|
6
|
|
|
|
|
8
|
$x = $block; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
} |
43
|
5
|
|
|
|
|
33
|
return $result; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# When we get a 'sensible' value, we want to produce noise; |
47
|
|
|
|
|
|
|
# when we get noise, we want to produce a sensible value. |
48
|
|
|
|
|
|
|
# We produce our noise by encrypting the sensible information and an equal |
49
|
|
|
|
|
|
|
# amount of randomness. Since our key is private, it will look like perfect |
50
|
|
|
|
|
|
|
# noise to anyone outside. |
51
|
|
|
|
|
|
|
# When we get any value, we check it it looks like noise by decrypting it. |
52
|
|
|
|
|
|
|
# If it decrypts, we retrieve the original value and return its compliment; |
53
|
|
|
|
|
|
|
# otherwise, we encrypt it with some randomness and return our noise. |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub Usrn ($) { |
56
|
10
|
|
|
10
|
0
|
18
|
my $arg = shift; |
57
|
10
|
|
|
|
|
18
|
my $val = _filter_noise($arg); |
58
|
10
|
100
|
|
|
|
44
|
return defined $val ? ~$val : _generate_noise($arg); |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub import { |
62
|
1
|
|
|
1
|
|
7
|
no strict 'refs'; |
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
90
|
|
63
|
1
|
|
|
1
|
|
9
|
*{caller().'::Usrn'} = \&Usrn; |
|
1
|
|
|
|
|
7
|
|
64
|
1
|
|
|
|
|
1861
|
1; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
1; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 NAME |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
Quantum::Usrn - Square root of not. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head1 SYNOPSIS |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
use Quantum::Usrn; |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
$noise = Usrn($value); |
78
|
|
|
|
|
|
|
$not_value = Usrn($noise); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=head1 DESCRIPTION |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
Provide the 'square root of not' function (Usrn), used by weird Quantum |
83
|
|
|
|
|
|
|
Physicists. Applying Usrn to a value will produce noise; applying Usrn to that |
84
|
|
|
|
|
|
|
noise will produce the bitwise negation of the original value. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
It all sounds a bit stange, and mostly useless. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=head1 HISTORY |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
On Monday 26th February 2001 I went to hear Damian Conway give his talk on |
91
|
|
|
|
|
|
|
Quantum::Superpositions at London.pm. During the talk he described the Physics |
92
|
|
|
|
|
|
|
of real quamtum superpositions, and mentioned the 'square root of not' operator. |
93
|
|
|
|
|
|
|
After explaining its properties (see above) he said "it is unlikely that you |
94
|
|
|
|
|
|
|
will see this operator in Perl any time soon". Well, we all know what happens |
95
|
|
|
|
|
|
|
when people say things like that... |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=head1 SEE ALSO |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
A good physics book or psychiatrist. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=head1 AUTHOR |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
Marty Pauley Emarty@kasei.comE |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=head1 COPYRIGHT |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
Copyright (C) 2001 Kasei |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
110
|
|
|
|
|
|
|
under the terms of either: |
111
|
|
|
|
|
|
|
a) the GNU General Public License; |
112
|
|
|
|
|
|
|
either version 2 of the License, or (at your option) any later version. |
113
|
|
|
|
|
|
|
b) the Perl Artistic License. |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
This module is distributed in the hope that it will be useful, although I |
116
|
|
|
|
|
|
|
doubt that it will be. There is NO WARRANTY, not even the implied warranty of |
117
|
|
|
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE; I can't think of any |
118
|
|
|
|
|
|
|
particular purpose that it would be fit for. |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=cut |