1 /*
2 * init.c --
3 *
4 * Implements the C level procedures handling the initialization of this package
5 *
6 *
7 * Copyright (c) 1996 Andreas Kupries (andreas_kupries@users.sourceforge.net)
8 * All rights reserved.
9 *
10 * Permission is hereby granted, without written agreement and without
11 * license or royalty fees, to use, copy, modify, and distribute this
12 * software and its documentation for any purpose, provided that the
13 * above copyright notice and the following two paragraphs appear in
14 * all copies of this software.
15 *
16 * IN NO EVENT SHALL I LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL,
17 * INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS
18 * SOFTWARE AND ITS DOCUMENTATION, EVEN IF I HAVE BEEN ADVISED OF THE
19 * POSSIBILITY OF SUCH DAMAGE.
20 *
21 * I SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
22 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
23 * PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND
24 * I HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES,
25 * ENHANCEMENTS, OR MODIFICATIONS.
26 *
27 * CVS: $Id: init.c,v 1.25 2007/10/05 23:12:20 andreas_kupries Exp $
28 */
29
30 #include "transformInt.h"
31
32 extern TrfStubs trfStubs;
33
34
35 /*
36 *------------------------------------------------------*
37 *
38 * Trf_Init --
39 *
40 * ------------------------------------------------*
41 * Standard procedure required by 'load'.
42 * Initializes this extension.
43 * ------------------------------------------------*
44 *
45 * Sideeffects:
46 * As of 'TrfGetRegistry'.
47 *
48 * Result:
49 * A standard Tcl error code.
50 *
51 *------------------------------------------------------*
52 */
53
54 int
Trf_Init(interp)55 Trf_Init (interp)
56 Tcl_Interp* interp;
57 {
58 Trf_Registry* registry;
59 int res;
60
61 #ifdef USE_TCL_STUBS
62 CONST char* actualVersion;
63
64 actualVersion = Tcl_InitStubs(interp, "8.1", 0);
65 if (actualVersion == NULL) {
66 return TCL_ERROR;
67 }
68 #endif
69
70 if (Trf_IsInitialized (interp)) {
71 /*
72 * catch multiple initialization of an interpreter
73 */
74 return TCL_OK;
75 }
76
77 registry = TrfGetRegistry (interp);
78
79 if (!registry) {
80 return TCL_ERROR;
81 }
82
83 #ifdef USE_TCL_STUBS
84 /*
85 * Discern which variant of stacked channels is or can be in use
86 * by the core which loaded us.
87 */
88
89 {
90 int major, minor, patchlevel, releasetype;
91 Tcl_GetVersion (&major, &minor, &patchlevel, &releasetype);
92
93 if (major > 8) {
94 /* Beyond 8.3.2 */
95 registry->patchVariant = PATCH_832;
96 } else if (major == 8) {
97 if ((minor > 3) ||
98 ((minor == 3) && (patchlevel > 1) &&
99 (releasetype == TCL_FINAL_RELEASE))) {
100 /* Is 8.3.2 or beyond */
101 registry->patchVariant = PATCH_832;
102 } else if (minor > 1) {
103 /* Is 8.2 or beyond */
104 registry->patchVariant = PATCH_82;
105 } else {
106 /* 8.0.x or 8.1.x */
107 registry->patchVariant = PATCH_ORIG;
108 }
109 } else /* major < 8 */ {
110 Tcl_AppendResult (interp,
111 "Cannot this compilation of Trf with a core below 8.0",
112 (char*) NULL);
113 return TCL_ERROR;
114 }
115 }
116 #endif
117
118 /*
119 * Register us as a now available package
120 */
121
122 PROVIDE (interp, trfStubs);
123 res = TrfInit_Unstack (interp);
124
125 if (res != TCL_OK)
126 return res;
127
128 res = TrfInit_Info (interp);
129
130 if (res != TCL_OK)
131 return res;
132
133 #ifdef ENABLE_BINIO
134 res = TrfInit_Binio (interp);
135
136 if (res != TCL_OK)
137 return res;
138 #endif
139
140 /*
141 * Register error correction algorithms.
142 */
143
144 res = TrfInit_RS_ECC (interp);
145
146 if (res != TCL_OK)
147 return res;
148
149 /*
150 * Register compressors.
151 */
152
153 res = TrfInit_ZIP (interp);
154
155 if (res != TCL_OK)
156 return res;
157
158 res = TrfInit_BZ2 (interp);
159
160 if (res != TCL_OK)
161 return res;
162
163 /*
164 * Register message digests
165 */
166
167 res = TrfInit_CRC (interp);
168
169 if (res != TCL_OK)
170 return res;
171
172 res = TrfInit_ADLER (interp);
173
174 if (res != TCL_OK)
175 return res;
176
177 res = TrfInit_CRC_ZLIB (interp);
178
179 if (res != TCL_OK)
180 return res;
181
182 res = TrfInit_MD5 (interp);
183
184 if (res != TCL_OK)
185 return res;
186
187 res = TrfInit_OTP_MD5 (interp);
188
189 if (res != TCL_OK)
190 return res;
191
192 res = TrfInit_MD2 (interp);
193
194 if (res != TCL_OK)
195 return res;
196
197 res = TrfInit_HAVAL (interp);
198
199 if (res != TCL_OK)
200 return res;
201
202 res = TrfInit_SHA (interp);
203
204 if (res != TCL_OK)
205 return res;
206
207 res = TrfInit_SHA1 (interp);
208
209 if (res != TCL_OK)
210 return res;
211
212 res = TrfInit_OTP_SHA1 (interp);
213
214 if (res != TCL_OK)
215 return res;
216
217 res = TrfInit_RIPEMD160 (interp);
218
219 if (res != TCL_OK)
220 return res;
221
222 res = TrfInit_RIPEMD128 (interp);
223
224 if (res != TCL_OK)
225 return res;
226
227 /*
228 * Register freeform transformation, reflector into tcl level
229 */
230
231 res = TrfInit_Transform (interp);
232
233 if (res != TCL_OK)
234 return res;
235
236 /*
237 * Register crypt commands for pwd auth.
238 */
239
240 res = TrfInit_Crypt (interp);
241
242 if (res != TCL_OK)
243 return res;
244
245 /*
246 * Register standard encodings.
247 */
248
249 res = TrfInit_Ascii85 (interp);
250
251 if (res != TCL_OK)
252 return res;
253
254 res = TrfInit_UU (interp);
255
256 if (res != TCL_OK)
257 return res;
258
259 res = TrfInit_B64 (interp);
260
261 if (res != TCL_OK)
262 return res;
263
264 res = TrfInit_Bin (interp);
265
266 if (res != TCL_OK)
267 return res;
268
269 res = TrfInit_Oct (interp);
270
271 if (res != TCL_OK)
272 return res;
273
274 res = TrfInit_OTP_WORDS (interp);
275
276 if (res != TCL_OK)
277 return res;
278
279 res = TrfInit_QP (interp);
280
281 if (res != TCL_OK)
282 return res;
283
284 return TrfInit_Hex (interp);
285 }
286
287 /*
288 *------------------------------------------------------*
289 *
290 * Trf_SafeInit --
291 *
292 * ------------------------------------------------*
293 * Standard procedure required by 'load'.
294 * Initializes this extension for a safe interpreter.
295 * ------------------------------------------------*
296 *
297 * Sideeffects:
298 * As of 'TrfGetRegistry'
299 *
300 * Result:
301 * A standard Tcl error code.
302 *
303 *------------------------------------------------------*
304 */
305
306 int
Trf_SafeInit(interp)307 Trf_SafeInit (interp)
308 Tcl_Interp* interp;
309 {
310 return Trf_Init (interp);
311 }
312
313 /*
314 *------------------------------------------------------*
315 *
316 * Trf_IsInitialized --
317 *
318 * ------------------------------------------------*
319 * Checks, wether the extension is initialized in
320 * the specified interpreter.
321 * ------------------------------------------------*
322 *
323 * Sideeffects:
324 * None.
325 *
326 * Result:
327 * 1 if and onlly if the extension is already
328 * initialized in the specified interpreter,
329 * 0 else.
330 *
331 *------------------------------------------------------*
332 */
333
334 int
Trf_IsInitialized(interp)335 Trf_IsInitialized (interp)
336 Tcl_Interp* interp;
337 {
338 Trf_Registry* registry;
339
340 registry = TrfPeekForRegistry (interp);
341
342 return registry != (Trf_Registry*) NULL;
343 }
344
345 #if GT81 && defined (TCL_THREADS) /* THREADING: lock procedures */
346 /*
347 *------------------------------------------------------*
348 *
349 * Trf(Un)LockIt --
350 *
351 * ------------------------------------------------*
352 * Internal functions, used to serialize write-access
353 * to several global variables. Required only for
354 * a thread-enabled Tcl 8.1.x and beyond.
355 * ------------------------------------------------*
356 *
357 * Sideeffects:
358 * None.
359 *
360 * Result:
361 * None.
362 *
363 *------------------------------------------------------*
364 */
365
TCL_DECLARE_MUTEX(trfInitMutex)366 TCL_DECLARE_MUTEX(trfInitMutex)
367
368 void
369 TrfLockIt ()
370 {
371 Tcl_MutexLock (&trfInitMutex);
372 }
373
374 void
TrfUnlockIt()375 TrfUnlockIt ()
376 {
377 Tcl_MutexUnlock (&trfInitMutex);
378 }
379
380 #endif /* GT81 */
381
382