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 (a.kupries@westend.com) 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 32extern 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 54int 55Trf_Init (interp) 56Tcl_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 306int 307Trf_SafeInit (interp) 308Tcl_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 334int 335Trf_IsInitialized (interp) 336Tcl_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 366TCL_DECLARE_MUTEX(trfInitMutex) 367 368void 369TrfLockIt () 370{ 371 Tcl_MutexLock (&trfInitMutex); 372} 373 374void 375TrfUnlockIt () 376{ 377 Tcl_MutexUnlock (&trfInitMutex); 378} 379 380#endif /* GT81 */ 381 382