1 (***********************************************************************
3 Mathematica-Compatible Notebook
5 This notebook can be used on any computer system with Mathematica 3.0,
6 MathReader 3.0, or any compatible application. The data for the notebook
7 starts with the line of stars above.
9 To get the notebook into a Mathematica-compatible application, do one of
12 * Save the data starting with the line of stars above into a file
13 with a name ending in .nb, then open the file inside the application;
15 * Copy the data starting with the line of stars above to the
16 clipboard, then use the Paste menu command inside the application.
18 Data for notebooks contains only printable 7-bit ASCII and can be
19 sent directly in email or through ftp in text mode. Newlines can be
20 CR, LF or CRLF (Unix, Macintosh or MS-DOS style).
22 NOTE: If you modify the data for this notebook not in a Mathematica-
23 compatible application, you must delete the line below containing the
24 word CacheID, otherwise Mathematica-compatible applications may try to
25 use invalid cache data.
27 For more information on notebooks and Mathematica-compatible
28 applications, contact Wolfram Research:
29 web: http://www.wolfram.com
30 email: info@wolfram.com
31 phone: +1-217-398-0700 (U.S.)
33 Notebook reader applications are available free of charge from
35 ***********************************************************************)
40 (*NotebookFileLineBreakTest
41 NotebookFileLineBreakTest*)
42 (*NotebookOptionsPosition[ 12180, 264]*)
43 (*NotebookOutlinePosition[ 12859, 289]*)
44 (* CellTagsIndexPosition[ 12815, 285]*)
45 (*WindowFrame->Normal*)
51 \(\( (*\n\tNo - Y - coordinate\ version\ of\ Algorithm\ 8.1 .10; \n\t
52 see\ program\ 8.1 .10 . directembed . nb\n\t\t\t\n\n\ Support\ code\
53 for\n\ R . \ Crandall\ and\ C . \ Pomerance, \n\
54 "\<Prime Numbers: a Computational Perspective,\>"\n\ Springer -
55 Verlag\ 2001. \n\ c . \ 2000\ Perfectly\ Scientific, \
56 Inc . \n\ All\ Rights\ Reserved . \n\t\n\t20\ Apr\ 2001\ RC\
57 \((revamped\ for\ simplicity)\)\n\ 10\ Dec\ 2000\ AH\
58 \((Formatting)\)\n\t14\ Sep\ 2000\ RT\ \((Creation)\)\n*) \n\)\)],
65 \n (*\ First, \ a\ function\ for\ inverting\ n\ mod\ \(p . \)\ *) \n
66 ellinv[n_]\ := \ If[n == 0, 0, PowerMod[n, \(-1\), p]]; \n
68 a\ function\ for\ normalizing\ the\ x\ \(coordinate . \)\ *) \n
69 ex[pt_]\ := \ Mod[pt[\([1]\)]\ *\ ellinv[pt[\([2]\)]], \ p]; \n
71 the\ doubleh \(()\)\ function\ for\ doubling\ a\ \(point . \)\ *) \n
72 elleven[pt_]\ := \ \n\t
73 Block[{x1\ = \ pt[\([1]\)], \ z1\ = \ pt[\([2]\)], \ e, \ f\ }, \n
75 Mod[\((x1^2\ - \ a\ z1^2)\)^2\ - \
76 4\ b\ \((2\ x1\ + \ c\ z1)\)\ z1^3, \ p]; \n\ \ \t\t
78 4\ z1\ \((x1^3\ + \ c\ x1^2\ z1\ + \ a\ x1\ z1^2\ + \ b\ z1^3)
79 \), \ p]; \n\ \ \t\t{e, f}\n\t]; \n
81 the\ addh \(()\)\ function\ for\ adding\ pt\ and\ pu\ with\ pv\ = \
83 \(\((x\ and\ z\ coordinates\ only\ of\ course)\) . \)\ *) \n
84 ellodd[pt_, \ pu_, \ pv_]\ := \ \n\t
85 Block[\n\t\t{x1\ = \ pt[\([1]\)], \ z1\ = \ pt[\([2]\)], \n\t\t\
86 x2\ = \ pu[\([1]\)], \ z2\ = \ pu[\([2]\)], \n\t\t\
87 xx\ = \ pv[\([1]\)], \ zz\ = \ pv[\([2]\)], \ i, \ j\n\t\t\ }, \n
90 zz\ \((\((x1\ x2\ - \ a\ z1\ z2)\)^2\ - \n
91 \ \ \t\ \ \ \ \ \ \ \ \ \ \t
92 4\ b \((x1\ z2\ + \ x2\ z1\ + \ c\ z1\ z2)\)\ z1\ z2)\),
93 \ \n\ \ \t\ \ \ \ \ \ \ \ \ \ \tp\n\ \ \t\ \ \ \ \ \ \ \ \ ]; \n
94 \ \ \t\ \ \ \ \ j\ = \ Mod[xx\ \((x1\ z2\ - \ x2\ z1)\)^2, \ p]; \n
95 \ \ \t\t\ {i, j}\n\t]; \n
96 \n (*\ Now, \ the\ main\ routine, \ elliptic\ multiply\ [k] \(pt . \)\ *)
97 \nelliptic[pt_, \ k_]\ := \ \n\t
98 Block[{porg, \ ps, \ pp, \ q}, \n\t\tIf[k\ == 1, \ Return[pt]]; \n\t\t
99 If[k\ == 2, \ Return[elleven[pt]]]; \n\t\tporg\ = \ pt; \n\t\t
100 ps\ = \ elleven[pt]; \n\t\tpp\ = \ pt; \n\t\t
101 bitlist\ = \ Reverse[IntegerDigits[k, 2]]; \n\t\t
102 Do[\t\ \ \ \n\t\ \ \ \t\t
103 If[bitlist[\([q]\)]\ == \ 1, \n\t\ \ \ \t\ \ \ \t\t
104 pp\ = \ ellodd[ps, \ pp, \ porg]; \n\t\ \ \ \t\ \ \ \t\t
105 ps\ = \ elleven[ps]\n\t\ \ \ \t\ \ \ \t\t, \n
106 \t\ \ \ \t\ \ \ \ \ \ \tps\ = \ ellodd[pp, \ ps, \ porg]; \n
107 \t\t\ \ \ \ \ \tpp\ = \ elleven[pp]\n\t\ \ \ \t\t]\n
109 \t\ \ \ \t\t{q, \ Length[bitlist] - 1, \ 1, \ \(-1\)}\n\ \ \ \ \t];
110 \n\ \ \ \ \tReturn[Mod[pp, p]]\n\t]; \n
112 we\ include\ algorithm\ 2.3 .8\ for\ finding\ square\ roots\ \nmodulo\
113 a\ prime\ \(p . \)\ *) \n\n
114 sqrtmod[b_, p_] := \ \n\t
115 Module[{a, x, c, d, cd, m, t, tst}, \n\ \ \ \t\ta\ = \ Mod[b, p]; \n
116 \ \ \ \t\tIf[p\ == \ 2, \ Return[a]]; \n\ \ \ \ \t
117 If[MemberQ[{3, 7}, Mod[p, 8]], \n\ \ \ \ \ \ \t\t
118 Return[PowerMod[a, \((p + 1)\)/4, p]]\n\ \ \ \ \ \ \t]; \n\ \ \ \ \t
119 If[Mod[p, 8]\ == \ 5, \n\ \ \ \ \ \ \t\t
120 x\ = \ PowerMod[a, \((p + 3)\)/8, p]; \n\ \ \ \ \ \ \t\t
121 c\ = \ Mod[x^2, p]; \n\ \ \ \ \ \ \t\t
122 If[Not[c\ == \ a], \n\ \ \ \ \ \ \ \ \t\t
123 Return[Mod[x\ PowerMod[2, \((p - 1)\)/4, p], \ p]]\n
124 \ \ \ \ \ \ \ \ \t]; \n\ \ \ \ \ \ \t]; \n\ \ \ \ \t\n
125 \ \ \ \ \t (*\ Here, \ p\ = \ 1\ \(\((mod\ 8)\) . \)\ *) \n
126 \ \ \ \ \ \ \ttst\ = \ 1; \n\ \ \ \ \ \ \t
127 While[Not[tst\ == \ \(-1\)], \n\ \ \ \ \ \ \ \ \t
128 d\ = \ Random[Integer, {1, p}]; \n\ \ \ \ \ \ \ \ \t
129 tst\ = \ JacobiSymbol[d, p]\n\ \ \ \ \ \ \ \ ]; \n\ \ \ \ \ \ \t
130 t\ = \ \((p - 1)\)/2; \ s\ = \ 1; \n\ \ \ \ \ \ \t
131 While[EvenQ[t], \ t\ = \ t/2; \ \(++s\)]; \n\ \ \ \ \ \ \t
132 ca\ = \ PowerMod[a, t, p]; \n\ \ \ \ \ \ \t
133 cd\ = \ PowerMod[d, t, p]; \n\ \ \ \ \ \ \tm\ = \ 0; \n
135 Do[\n\ \ \ \ \ \ \t\ \ \
136 If[PowerMod[Mod[ca\ PowerMod[cd, \ m, \ p], p], \
137 2^\((s - 1 - i)\), \ p]\n\ \ \ \ \ \ \t\ \ \ \t\t == \ p - 1,
138 \ m\ += \ 2^i]\n\ \ \ \ \ \ \t\ \ \ , {i, 0, s - 1}\n
139 \ \ \ \ \ \ \t]; \ \ \ \ \ \ \t\ \ \ \ \n\ \ \ \ \ \ \t
140 Return[Mod[PowerMod[a, \ \((t + 1)\)/2, p]\ PowerMod[cd, \ m/2, p],
142 \n (*\ Next, \ a\ function\ relevant\ to\ Algorithm\ 7.2 \( .8 . \)\ *) \n
143 \nellXadd[x1_, x2_] := \n\t
144 Module[{u2, v, g}, \[IndentingNewLine]\t\tg = x1 - x2;
145 \[IndentingNewLine]\t\tden = PowerMod[g, \(-2\), p];
146 \[IndentingNewLine]\t\t
148 \((\((x1\ x2 + a)\) \((x1 + x2)\) + 2 c\ x1\ x2 + 2 b)\), p];
149 \[IndentingNewLine]\t\t
150 beta = Mod[\((\((x1\ x2 - a)\)^2 - 4 b \((x1 + x2 + c)\))\), p];
151 \[IndentingNewLine]\t\tdisc = Mod[alpha^2 - beta\ g^2, p];
152 \[IndentingNewLine]\t\t{\ \
153 Mod[\ den*\((alpha + sqrtmod[disc, p])\), p], \ \n\t\t\ \ \ \
154 Mod[den*\((alpha - sqrtmod[disc, p])\), p]\n\t\t}
155 \[IndentingNewLine]\t]; \n
157 the\ main\ routine . \ Parameters\ are\ given\ for\ 161 -
158 bit\ prime\ field\n\t\t\tand\ specific\ curve; \n\t\ \
159 direct\ embedding\ proceeds\ on\ "\<plaintext\>"\ integers\ x\
160 \((mod\ p)\) . \ \n\ \ \ We\ start\ with\ relevant\ global\
161 \((and\ public, \ except\ for\ kb)\)\n\ \ \ \(parameters . \)\n\ *) \n
162 \[IndentingNewLine]p\ = \
163 1654338658923174831024422729553880293604080853451; \na\ = \ \(-152\);
164 \nb = \ 722; \nc\ = \ 0; \ \ (*\ Montgomery\ \(parameter . \)\ *) \n
166 create\ public\ point\ P\ of\ prime\ order\ on\ main\ \(curve . \)\ *)
168 \ {124590448755381588517063157600522073397838354227, \ 1}; \ \ \n
170 \ {1173563507729187954550227059395955904200719019884, 1}; \n\n
171 kb\ = \ 968525826201321079923232842886222248;
172 \ \ (*\ Private\ key\ \(K_B . \)\ *) \n\n
173 pubkey\ = \ \ \ elliptic[pubpoint, \ kb];
174 \ \ \ \ \ \ \ \ (*\ Public\ key\ \(P_B . \)\ *) \n
175 pubkeytwist\ = \ \telliptic[pubpointtwist, \ kb];
176 \ \ \ \ \ (*\ Public\ key\ \(P_B' . \)\ *) \n\ \n\t\t\n
177 encryptEmbed[x_] := \
178 Module[{cubic, \ curve, \ X\ = \ x, \ pbk, \ pbp, \ clueX, \ X2, \ uX,
179 \n\t\t\ \ piece, \ try, \ sign},
180 \[IndentingNewLine] (*\ First, \
181 let\ us\ determine\ which\ curve . \ \n\t\t\ \ \ EITHER\ X\ lies\ in
182 \ the\ curve\ y^2\ = \ X^3\ + \ c\ X^2\ + \ a\ X\ + \ b, \n
184 or\ on\ g\ y^2\ = \ X^3\ + \ c\ X^2\ + \ a\ X\ + \ b\ *) \n
185 \t\t\ cubic\ = \ Mod[X\ Mod[X^2\ + c\ X\ + \ \ a, p]\ + \ b, p];
186 \n\t\t\ If[JacobiSymbol[cubic, \ p]\ > \ \(-1\), \ \n
187 \t\t\t\ \ \ \ \ \ curve\ = \ 1; \ pbk\ = \ pubkey; \
188 pbp\ = \ pubpoint, \t\t\t\ \ \ \ \ \ \n\t\t\t\t\ \ \ \ \
189 curve\ = \ \(-1\)\ ; \ pbk\ = \ pubkeytwist; \
190 pbp\ = \ pubpointtwist; \ \n\t\t\ \ ]; \n\t\t\n\t\t\t
191 r\ = \ Random[Integer, \ {2, p - 2}]; \t\t\ \ \n\t\t\t
192 clueX\ = \ ex[elliptic[pbp, \ r]]; \n\t\t\ \
193 X2\ = \ ex[elliptic[pbk, \ r]];
194 \ (*\ We\ shall\ be\ adding\ the\ points\ having\ X, \ X2, \
195 and\n\t\t\t\t\t\ \ \ there\ is\ a\ sign\ ambiguity\ a\ la\ Algorithm
196 \ 7.2 .8\ because\ Y -
197 coordinates\n\t\t\t\t\t\t\ \ are\ being\ \(avoided . \)\ *) \ \n
198 \t\t\ \ \ uX\ = \ \(ellXadd[X, \ X2]\)[\([1]\)]; \n\t\t\n
200 feedback\ loop\ to\ determine\ which\ value\ of\ sign\ recovers\
201 \(plaintext . \)\ *) \n\t\t\n\t\t\ \ \
202 piece\ = \ ex[elliptic[{clueX, 1}, \ kb]]; \t\t\ \n\t\t\ \ \
203 try\ = \ ellXadd[uX, \ piece]; \n\n\t\t\t\
204 If[\ttry[\([1]\)]\ == \ X, \ sign\ = \ 1, \n
205 \t\t\t\ \ \ \ \ \ \ \ \ \ \ \ \ \ \
206 If[try[\([2]\)]\ == \ X, \ sign\ = \ \(-1\), \ Print["\<TILT!\>"]]
207 \n\t\t\t]; \t\t\t\t\ \ \ \ \ \ \ \ \n
208 \t\t\ \ {uX, \ clueX, \ curve, \ sign}\[IndentingNewLine]];
209 \[IndentingNewLine]\n
210 decryptEmbed[cipherList_] := \
211 Module[{uX\ = \ cipherList[\([1]\)], \
212 clueX\ = \ cipherList[\([2]\)], \ curve\ = \ cipherList[\([3]\)],
213 \ sign\ = \ cipherList[\([4]\)]}, \n\t\t\ \ \
214 piece\ = \ ex[elliptic[{clueX, 1}, \ kb]]; \t\t\ \n\t\t\ \ \
215 try\ = \ ellXadd[uX, \ piece]; \n\t\t\ \ \
216 X\ = \ try[\([\((3 - sign)\)/2]\)]; \n\t\t\tX\[IndentingNewLine]];
217 \[IndentingNewLine]\n\)\)], "Input"],
220 \(General::"spell1" \( : \ \)
221 "Possible spelling error: new symbol name \"\!\(beta\)\" is similar to \
222 existing symbol \"\!\(Beta\)\"."\)], "Message"],
225 \(General::"spell1" \( : \ \)
226 "Possible spelling error: new symbol name \"\!\(sign\)\" is similar to \
227 existing symbol \"\!\(Sign\)\"."\)], "Message"]
233 \(\( (*\ EXAMPLE\ *) \ \n\n
234 ciph\ = \ encryptEmbed[plain\ = \ Random[Integer, p - 1]]; \n
235 If[decryptEmbed[ciph]\ != \ plain, \ Print["\<TILT!\>"]], {ct, 1, 10}]
239 \(General::"spell1" \( : \ \)
240 "Possible spelling error: new symbol name \"\!\(plain\)\" is similar to \
241 existing symbol \"\!\(Plain\)\"."\)], "Message"]
250 \(1654338658923174831024422729553880293604080853451\)], "Output"]
263 \(6277101735386680763835789423207666416083908700390324961279\)], "Input"]
265 FrontEndVersion->"NeXT 3.0",
266 ScreenRectangle->{{0, 957}, {0, 768}},
268 WindowSize->{762, 676},
269 WindowMargins->{{Automatic, 11}, {Automatic, 24}},
274 (***********************************************************************
275 Cached data follows. If you edit this Notebook file directly, not using
276 Mathematica, you must remove the line containing CacheID at the top of
277 the file. The cache data will then be recreated when you save this file
278 from within Mathematica.
279 ***********************************************************************)
289 (*NotebookFileOutline
291 Cell[1709, 49, 576, 9, 242, "Input"],
294 Cell[2310, 62, 8704, 154, 2269, "Input"],
295 Cell[11017, 218, 175, 3, 33, "Message"],
296 Cell[11195, 223, 175, 3, 33, "Message"]
300 Cell[11407, 231, 215, 4, 65, "Input"],
301 Cell[11625, 237, 177, 3, 33, "Message"]
305 Cell[11839, 245, 34, 1, 25, "Input"],
306 Cell[11876, 248, 83, 1, 24, "Output"]
310 Cell[11996, 254, 35, 1, 24, "Input"],
311 Cell[12034, 257, 36, 1, 24, "Output"]
313 Cell[12085, 261, 91, 1, 24, "Input"]
321 (***********************************************************************
322 End of Mathematica Notebook file.
323 ***********************************************************************)