+++ /dev/null
-/*
- * Copyright (c) 2000-2001 Apple Computer, Inc. All Rights Reserved.
- *
- * The contents of this file constitute Original Code as defined in and are
- * subject to the Apple Public Source License Version 1.2 (the 'License').
- * You may not use this file except in compliance with the License. Please obtain
- * a copy of the License at http://www.apple.com/publicsource and read it before
- * using this file.
- *
- * This Original Code and all software distributed under the License are
- * distributed on an 'AS IS' basis, WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS
- * OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES, INCLUDING WITHOUT
- * LIMITATION, ANY WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
- * PURPOSE, QUIET ENJOYMENT OR NON-INFRINGEMENT. Please see the License for the
- * specific language governing rights and limitations under the License.
- */
-
-
-// file: .../c++-lib/src/tcl-if.C
-//
-// $Header: /cvs/root/Security/SecuritySNACCRuntime/c++-lib/c++/Attic/tcl-if.cpp,v 1.1.1.1 2001/05/18 23:14:06 mb Exp $
-// $Log: tcl-if.cpp,v $
-// Revision 1.1.1.1 2001/05/18 23:14:06 mb
-// Move from private repository to open source repository
-//
-// Revision 1.2 2001/05/05 00:59:17 rmurphy
-// Adding darwin license headers
-//
-// Revision 1.1 2000/06/15 18:44:58 dmitch
-// These snacc-generated source files are now checked in to allow cross-platform build.
-//
-// Revision 1.2 2000/06/08 20:05:37 dmitch
-// Mods for X port. These files are actually machine generated and probably don't need to be in CVS....
-//
-// Revision 1.1.1.1 2000/03/09 01:00:06 rmurphy
-// Base Fortissimo Tree
-//
-// Revision 1.2 1999/02/26 00:23:41 mb
-// Fixed for Mac OS 8
-//
-// Revision 1.1 1999/02/25 05:21:57 mb
-// Added snacc c++ library
-//
-// Revision 1.6 1997/02/28 13:39:47 wan
-// Modifications collected for new version 1.3: Bug fixes, tk4.2.
-//
-// Revision 1.5 1997/01/01 23:24:35 rj
-// `typename' appears to be a reserved word in gcc 2.7, so prefix it with `_'
-//
-// Revision 1.4 1995/09/07 18:57:13 rj
-// duplicate code merged into a new function SnaccTcl::gettypedesc().
-//
-// Revision 1.3 1995/08/17 15:09:09 rj
-// snacced.[hC] renamed to tcl-if.[hC].
-// class SnaccEd renamed to SnaccTcl.
-// set Tcl's errorCode variable.
-//
-// Revision 1.2 1995/07/27 09:53:38 rj
-// comment leader fixed
-//
-// Revision 1.1 1995/07/27 09:52:22 rj
-// new file: tcl interface used by snacced.
-
-#if !defined(macintosh) && !defined(__APPLE__)
-#include <sys/types.h>
-#include <sys/stat.h>
-#endif
-#include <fcntl.h>
-#include <assert.h>
-#include <unistd.h>
-#include <stdlib.h>
-#include <strstream.h>
-#include <fstream.h>
-#include <string.h>
-
-#include "asn-incl.h"
-
-#if TCL
-
-#ifdef _AIX32
-extern "C" int strncasecmp (const char* s1, const char* s2, size_t number);
-extern "C" int strcasecmp (const char* s1, const char* s2);
-#endif
-
-#include "tcl-if.h"
-#include "init.h"
-
-//\[banner "utility functions"]-----------------------------------------------------------------------------------------------------
-static bool strniabbr (const char *pattern, const char *test, size_t min)
-{
- register len;
-
- if (strlen (pattern)<min)
- fprintf (stderr, "strniabbr(): strlen (pattern) < min\n");
- if ((len = strlen (test))<min)
- return false;
- return !strncasecmp (pattern, test, len);
-}
-
-//\[banner "ctor & dtor"]-----------------------------------------------------------------------------------------------------------
-ASN1File::ASN1File (const AsnTypeDesc *typedesc)
-{
- type = typedesc;
- pdu = type->create();
- fn = NULL;
- fd = -1;
- filesize = 0;
-}
-
-ASN1File::ASN1File (const AsnTypeDesc *typedesc, const char *_fn, int _fd)
-{
- type = typedesc;
- pdu = type->create();
-
- int fnlen = strlen (_fn) + 1;
- fn = new char [fnlen];
- memcpy (fn, _fn, fnlen);
-
- fd = _fd;
-}
-
-ASN1File::~ASN1File()
-{
- delete pdu;
- delete fn;
- if (fd >= 0)
- close (fd);
-}
-
-bool ASN1File::bad()
-{
- return fd < 0;
-}
-
-int ASN1File::finfo (Tcl_Interp *interp)
-{
- Tcl_AppendElement (interp, fn ? fn : "");
- char *acc = "bad";
- if (!bad())
- {
- int flags;
- if ((flags = fcntl (fd, F_GETFL)) != -1)
- switch (flags & O_ACCMODE)
- {
- case O_RDONLY:
- acc = "ro";
- break;
- case O_WRONLY:
- acc = "wo";
- break;
- case O_RDWR:
- acc = "rw";
- break;
- }
- }
- Tcl_AppendElement (interp, acc);
-
- return TCL_OK;
-}
-
-int ASN1File::read (Tcl_Interp *interp, const char *rfn)
-{
- int rfd;
- TmpFD tmpfd;
-
- delete pdu;
- pdu = type->create();
-
- if (rfn)
- {
- if ((rfd = open (rfn, O_RDONLY)) < 0)
- {
- Tcl_AppendResult (interp, "can't open \"", rfn, "\": ", Tcl_PosixError (interp), NULL);
- return TCL_ERROR;
- }
- tmpfd = rfd;
- }
- else if (fd < 0)
- {
- Tcl_AppendResult (interp, "can't read, file is not open", NULL);
- Tcl_SetErrorCode (interp, "SNACC", "MUSTOPEN", NULL);
- return TCL_ERROR;
- }
- else
- {
- rfn = fn;
- lseek (rfd = fd, 0l, SEEK_SET);
- }
-
- struct stat statbuf;
- if (fstat (rfd, &statbuf))
- {
- Tcl_AppendResult (interp, "can't fstat \"", rfn, "\": ", Tcl_PosixError (interp), NULL);
- return TCL_ERROR;
- }
-
- filesize = statbuf.st_size;
-
- char* buf = new char[filesize];
- if (::read (rfd, buf, filesize) != filesize)
- {
- Tcl_AppendResult (interp, "can't read \"", rfn, "\": ", Tcl_PosixError (interp), NULL);
- delete buf;
- return TCL_ERROR;
- }
-
- AsnBuf inputBuf;
- inputBuf.InstallData (buf, filesize);
-
- size_t decodedLen = 0;
- jmp_buf env;
- int eval;
- if (eval = setjmp (env))
- {
- char eno[80];
- sprintf (eno, "%d", eval);
- Tcl_AppendResult (interp, "can't decode (error ", eno, ")", NULL);
- Tcl_SetErrorCode (interp, "SNACC", "DECODE", eno, NULL);
- delete buf;
- return TCL_ERROR;
- }
- pdu->BDec (inputBuf, decodedLen, env);
- if (inputBuf.ReadError())
- {
- Tcl_AppendResult (interp, "can't decode, out of data", NULL);
- Tcl_SetErrorCode (interp, "SNACC", "DECODE", "EOBUF", NULL);
- delete buf;
- return TCL_ERROR;
- }
-
-#if DEBUG
-cout << "DECODED:" << endl << *pdu << endl;
-#endif
-
- if (decodedLen != filesize)
- sprintf (interp->result, "decoded %d of %d bytes", decodedLen, filesize);
-
- delete buf;
- return TCL_OK;
-}
-
-int ASN1File::write (Tcl_Interp *interp, const char *wfn)
-{
- int wfd;
- TmpFD tmpfd;
-
- if (wfn)
- {
- if ((wfd = open (wfn, O_CREAT|O_TRUNC|O_WRONLY, 0666)) < 0)
- {
- Tcl_AppendResult (interp, "can't open \"", wfn, "\": ", Tcl_PosixError (interp), NULL);
- return TCL_ERROR;
- }
- tmpfd = wfd;
- }
- else if (fd < 0)
- {
- Tcl_AppendResult (interp, "can't write, file is not open", NULL);
- Tcl_SetErrorCode (interp, "SNACC", "MUSTOPEN", NULL);
- return TCL_ERROR;
- }
- else
- {
- wfn = fn;
- int flags;
- if ((flags = fcntl (fd, F_GETFL)) == -1)
- {
- Tcl_AppendResult (interp, "can't fcntl \"", wfn, "\": ", Tcl_PosixError (interp), NULL);
- return TCL_ERROR;
- }
- else
- {
- if ((flags & O_ACCMODE) == O_RDONLY)
- {
- Tcl_AppendResult (interp, "can't write, file is read only", NULL);
- Tcl_SetErrorCode (interp, "SNACC", "WRITE", "RDONLY", NULL);
- return TCL_ERROR;
- }
- }
- lseek (wfd = fd, 0l, SEEK_SET);
- }
-
- size_t size = filesize ? filesize : 10240;
- char *buf;
- AsnBuf outputBuf;
- size_t encodedLen;
- for (;;)
- {
- size <<= 1;
- buf = new char[size];
- outputBuf.Init (buf, size);
- outputBuf.ResetInWriteRvsMode();
- encodedLen = pdu->BEnc (outputBuf);
- if (!outputBuf.WriteError())
- break;
- delete buf;
- }
-
- outputBuf.ResetInReadMode();
- size_t hunklen = 8192;
- char* hunk = new char[hunklen];
- for (size_t written=0; written<encodedLen; written+=hunklen)
- {
- if (encodedLen-written < hunklen)
- hunklen = encodedLen - written;
- outputBuf.CopyOut (hunk, hunklen);
- if (::write (wfd, hunk, hunklen) != hunklen)
- {
- Tcl_AppendResult (interp, "write error on \"", wfn, "\": ", Tcl_PosixError (interp), NULL);
- delete hunk; // may affect errno
- delete buf; // may affect errno
- return TCL_ERROR;
- }
- }
-
- delete hunk;
- delete buf;
-
- filesize = encodedLen;
- if (!wfn)
- ftruncate (wfd, filesize);
-
- return TCL_OK;
-}
-
-//\[banner "import & export"]-------------------------------------------------------------------------------------------------------
-int import (Tcl_Interp *interp, int argc, char **argv)
-{
- if (argc != 2)
- {
- strcpy (interp->result, "wrong # args: should be \"snacc import filename\"");
- return TCL_ERROR;
- }
-
- const char *fn = argv[1];
- int fd;
- if ((fd = open (fn, O_RDONLY)) < 0)
- {
- Tcl_AppendResult (interp, "can't open \"", fn, "\": ", Tcl_PosixError (interp), NULL);
- return TCL_ERROR;
- }
- TmpFD tmpfd (fd);
-
- struct stat statbuf;
- if (fstat (fd, &statbuf))
- {
- Tcl_AppendResult (interp, "can't fstat \"", fn, "\"'s fd: ", Tcl_PosixError (interp), NULL);
- return TCL_ERROR;
- }
-
- off_t filesize = statbuf.st_size;
-
- char* ibuf = new char[filesize];
- if (::read (fd, ibuf, filesize) != filesize)
- {
- Tcl_AppendResult (interp, "read error on \"", fn, "\": ", Tcl_PosixError (interp), NULL);
- delete ibuf;
- return TCL_ERROR;
- }
-
- int result = debinify (interp, ibuf, filesize);
- delete ibuf;
- return result;
-}
-
-int export (Tcl_Interp *interp, int argc, char **argv)
-{
- if (argc != 3)
- {
- strcpy (interp->result, "wrong # args: should be \"snacc export str filename\"");
- return TCL_ERROR;
- }
-
- const char *str = argv[1], *fn = argv[2];
- char* obuf = new char[strlen (str)]; // the binary buffer is as most as long as the escaped Tcl string.
- size_t olen;
- if (binify (interp, str, obuf, &olen) != TCL_OK)
- {
- delete obuf;
- return TCL_ERROR;
- }
-
- int fd;
- if ((fd = open (fn, O_CREAT|O_TRUNC|O_WRONLY, 0666)) < 0)
- {
- Tcl_AppendResult (interp, "can't open \"", fn, "\": ", Tcl_PosixError (interp), NULL);
- delete obuf;
- return TCL_ERROR;
- }
- TmpFD tmpfd (fd);
-
- if (::write (fd, obuf, olen) != olen)
- {
- Tcl_AppendResult (interp, "write error on \"", fn, "\": ", Tcl_PosixError (interp), NULL);
- delete obuf;
- return TCL_ERROR;
- }
-
- delete obuf;
- return TCL_OK;
-}
-
-//\[banner "ctor & dtor"]-----------------------------------------------------------------------------------------------------------
-SnaccTcl::SnaccTcl (Tcl_Interp *i)
-{
- interp = i;
-
- Tcl_InitHashTable (&modules, TCL_STRING_KEYS);
- Tcl_InitHashTable (&types, TCL_STRING_KEYS);
-
- const AsnModuleDesc **moddesc;
- for (moddesc=asnModuleDescs; *moddesc; moddesc++)
- {
- int created;
- Tcl_HashEntry *entry = Tcl_CreateHashEntry (&modules, (char*)(*moddesc)->name, &created);
- assert (created);
- Tcl_SetHashValue (entry, *moddesc);
-
- const AsnTypeDesc **typedesc;
- for (typedesc=(*moddesc)->types; *typedesc; typedesc++)
- {
- char buf[1024];
- sprintf (buf, "%s %s", (*moddesc)->name, (*typedesc)->name);
- char *_typename = strdup (buf);
- int created;
- Tcl_HashEntry *entry = Tcl_CreateHashEntry (&types, _typename, &created);
- if (!created)
- {
- cerr << "fatal error: duplicate type " << _typename << endl;
- exit (1);
- }
- Tcl_SetHashValue (entry, *typedesc);
- }
- }
-
- Tcl_InitHashTable (&files, TCL_STRING_KEYS);
-}
-
-SnaccTcl::~SnaccTcl()
-{
- Tcl_DeleteHashTable (&files);
-}
-
-//\[banner "utility functions"]-----------------------------------------------------------------------------------------------------
-const AsnTypeDesc *SnaccTcl::gettypedesc (const char *cmdname, const char *_typename)
-{
- Tcl_HashEntry *typedescentry;
- if (typedescentry = Tcl_FindHashEntry (&types, (char*)_typename))
- return (const AsnTypeDesc *)Tcl_GetHashValue (typedescentry);
- else
- {
- Tcl_SetErrorCode (interp, "SNACC", "ILLTYPE", NULL);
- Tcl_AppendResult (interp, "snacc ", cmdname, ": no type \"", _typename, "\"", NULL);
- return NULL;
- }
-}
-
-//\[banner "data manipulation functions"]-------------------------------------------------------------------------------------------
-Tcl_HashEntry *SnaccTcl::create()
-{
- static unsigned int id;
- int created;
- Tcl_HashEntry *entry;
- do
- {
- sprintf (interp->result, "file%u", id++);
- entry = Tcl_CreateHashEntry (&files, interp->result, &created);
- }
- while (!created);
- return entry;
-}
-
-int SnaccTcl::create (int argc, char **argv)
-{
- if (argc != 2)
- {
- strcpy (interp->result, "wrong # args: should be \"snacc create {module type}\"");
- return TCL_ERROR;
- }
-
- const char *_typename = argv[1];
- const AsnTypeDesc *typedesc;
- if (!(typedesc = gettypedesc ("type", _typename)))
- return TCL_ERROR;
-
- Tcl_HashEntry *entry = create();
- ASN1File *file = new ASN1File (typedesc);
- Tcl_SetHashValue (entry, file);
-
- return TCL_OK;
-}
-
-//\[sep]----------------------------------------------------------------------------------------------------------------------------
-// snacc open {module type} filename ?flags? ?permissions?
-
-int SnaccTcl::openfile (int argc, char **argv)
-{
- if (argc < 3 || argc > 5)
- {
- strcpy (interp->result, "wrong # args: should be \"snacc open {module type} filename ?flags? ?permissions?\"");
- return TCL_ERROR;
- }
-
- const char *_typename = argv[1];
- const char *filename = argv[2];
- bool rw_spec = false;
- int oflags = 0, omode = 0666, fd = -1;
-
- switch (argc)
- {
- case 5:
- if (Tcl_GetInt (interp, argv[4], &omode))
- return TCL_ERROR;
- // \(da fall thru
- case 4:
- {
- Args flags;
- if (Tcl_SplitList (interp, argv[3], &flags.c, &flags.v) != TCL_OK)
- return TCL_ERROR;
-
- for (int i=0; i<flags.c; i++)
- {
- if (strniabbr ("truncate", flags.v[i], 1))
- oflags |= O_TRUNC;
- else if (strniabbr ("create", flags.v[i], 1))
- oflags |= O_CREAT;
- else if (!strcasecmp ("ro", flags.v[i]))
- {
- oflags |= O_RDONLY;
- rw_spec = true;
- }
- else if (!strcasecmp ("rw", flags.v[i]))
- {
- oflags |= O_RDWR;
- rw_spec = true;
- }
- else
- {
- Tcl_AppendResult (interp, "snacc open: illegal argument \"", flags.v[i], "\" in flags", NULL);
- return TCL_ERROR;
- }
- }
- }
- break;
- }
-
- const AsnTypeDesc *typedesc;
- if (!(typedesc = gettypedesc ("open", _typename)))
- return TCL_ERROR;
-
- if (rw_spec)
- fd = open (filename, oflags, omode);
- else
- if ((fd = open (filename, oflags | O_RDWR, omode)) < 0)
- fd = open (filename, oflags | O_RDONLY, omode);
-
- if (fd < 0)
- {
- Tcl_AppendResult (interp, "can't open \"", filename, "\": ", Tcl_PosixError (interp), NULL);
- return TCL_ERROR;
- }
-
- ASN1File *file = new ASN1File (typedesc, filename, fd);
- if (file->bad())
- {
- delete file;
- Tcl_AppendResult (interp, "internal error on \"", filename, "\": bad status", NULL);
- Tcl_SetErrorCode (interp, "SNACC", "OPEN", "BAD", NULL);
- return TCL_ERROR;
- }
-
- Tcl_HashEntry *entry = create();
- Tcl_SetHashValue (entry, file);
-
- return file->read (interp);
-}
-
-//\[sep]----------------------------------------------------------------------------------------------------------------------------
-int SnaccTcl::finfo (int argc, char **argv)
-{
- if (argc != 2)
- {
- strcpy (interp->result, "wrong # args: should be \"snacc finfo file\"");
- return TCL_ERROR;
- }
-
- Tcl_HashEntry *entry = Tcl_FindHashEntry (&files, argv[1]);
- if (!entry)
- {
- Tcl_AppendResult (interp, "no file named \"", argv[1], "\"", NULL);
- return TCL_ERROR;
- }
-
- ASN1File *file = (ASN1File *)Tcl_GetHashValue (entry);
-
- return file->finfo (interp);
-}
-
-//\[sep]----------------------------------------------------------------------------------------------------------------------------
-// snacc read file ?{module type} filename?
-
-int SnaccTcl::read (int argc, char **argv)
-{
- const char *_typename, *filename;
-
- switch (argc)
- {
- case 2: // reread from old fd
- _typename = filename = NULL;
- break;
- case 4:
- _typename = argv[2];
- filename = argv[3];
- break;
- default:
- strcpy (interp->result, "wrong # args: should be \"snacc read file ?{module type} filename?\"");
- return TCL_ERROR;
- }
-
- Tcl_HashEntry *entry = Tcl_FindHashEntry (&files, argv[1]);
- if (!entry)
- {
- Tcl_AppendResult (interp, "no file named \"", argv[1], "\"", NULL);
- return TCL_ERROR;
- }
-
- ASN1File *file = (ASN1File *)Tcl_GetHashValue (entry);
-
- if (_typename)
- {
- const AsnTypeDesc *typedesc;
- if (!(typedesc = gettypedesc ("read", _typename)))
- return TCL_ERROR;
-
- delete file;
- file = new ASN1File (typedesc);
- Tcl_SetHashValue (entry, file);
- }
-
- return file->read (interp, filename);
-}
-
-//\[sep]----------------------------------------------------------------------------------------------------------------------------
-int SnaccTcl::write (int argc, char **argv)
-{
- if (argc < 2 || argc > 3)
- {
- strcpy (interp->result, "wrong # args: should be \"snacc write file ?filename?\"");
- return TCL_ERROR;
- }
-
- Tcl_HashEntry *entry = Tcl_FindHashEntry (&files, argv[1]);
- if (!entry)
- {
- Tcl_AppendResult (interp, "no file named \"", argv[1], "\"", NULL);
- return TCL_ERROR;
- }
-
- ASN1File *file = (ASN1File *)Tcl_GetHashValue (entry);
-
- return file->write (interp, argv[2]);
-}
-
-//\[sep]----------------------------------------------------------------------------------------------------------------------------
-int SnaccTcl::closefile (int argc, char **argv)
-{
- if (argc != 2)
- {
- strcpy (interp->result, "wrong # args: should be \"snacc close file\"");
- return TCL_ERROR;
- }
-
- Tcl_HashEntry *entry = Tcl_FindHashEntry (&files, argv[1]);
- if (!entry)
- {
- Tcl_AppendResult (interp, "no file named \"", argv[1], "\"", NULL);
- return TCL_ERROR;
- }
-
- ASN1File *file = (ASN1File *)Tcl_GetHashValue (entry);
- delete file;
-
- Tcl_DeleteHashEntry (entry);
-
- return TCL_OK;
-}
-
-//\[sep]----------------------------------------------------------------------------------------------------------------------------
-int SnaccTcl::modulesinfo (int argc, char **argv)
-{
- if (argc != 1)
- {
- strcpy (interp->result, "wrong # args: should be \"snacc modules\"");
- return TCL_ERROR;
- }
-
- Tcl_HashEntry *moduleentry;
- Tcl_HashSearch hi;
- for (moduleentry=Tcl_FirstHashEntry (&modules, &hi); moduleentry; moduleentry=Tcl_NextHashEntry (&hi))
- Tcl_AppendElement (interp, Tcl_GetHashKey (&modules, moduleentry));
-
- return TCL_OK;
-}
-
-//\[sep]----------------------------------------------------------------------------------------------------------------------------
-int SnaccTcl::typesinfo (int argc, char **argv)
-{
- switch (argc)
- {
- case 1:
- Tcl_HashEntry *typeentry;
- Tcl_HashSearch hi;
- for (typeentry=Tcl_FirstHashEntry (&types, &hi); typeentry; typeentry=Tcl_NextHashEntry (&hi))
- Tcl_AppendElement (interp, Tcl_GetHashKey (&types, typeentry));
- return TCL_OK;
- case 2:
- Tcl_HashEntry *moduleentry;
- if (moduleentry = Tcl_FindHashEntry (&modules, argv[1]))
- {
- const AsnModuleDesc *moddesc = (const AsnModuleDesc *)Tcl_GetHashValue (moduleentry);
- const AsnTypeDesc **typedesc;
- for (typedesc=moddesc->types; *typedesc; typedesc++)
- Tcl_AppendElement (interp, (char*)(*typedesc)->name);
- return TCL_OK;
- }
- else
- {
- Tcl_AppendResult (interp, "snacc types: no module \"", argv[1], "\"", NULL);
- return TCL_ERROR;
- }
- default:
- strcpy (interp->result, "wrong # args: should be \"snacc types ?module?\"");
- return TCL_ERROR;
- }
-}
-
-//\[sep]----------------------------------------------------------------------------------------------------------------------------
-int SnaccTcl::typeinfo (int argc, char **argv)
-{
- if (argc != 2)
- {
- strcpy (interp->result, "wrong # args: should be \"snacc type {module type}\"");
- return TCL_ERROR;
- }
-
- const char *_typename = argv[1];
- const AsnTypeDesc *typedesc;
- if (!(typedesc = gettypedesc ("type", _typename)))
- return TCL_ERROR;
-
- Tcl_DString desc;
- Tcl_DStringInit (&desc);
- int rc = typedesc->TclGetDesc (&desc);
- Tcl_DStringResult (interp, &desc);
- return rc;
-}
-
-//\[sep]----------------------------------------------------------------------------------------------------------------------------
-int SnaccTcl::info (int argc, char **argv)
-{
- if (argc != 2)
- {
- strcpy (interp->result, "wrong # args: should be \"snacc info path\"");
- return TCL_ERROR;
- }
-
- Args path;
- if (Tcl_SplitList (interp, argv[1], &path.c, &path.v) != TCL_OK)
- return TCL_ERROR;
-
- if (path.c < 1)
- {
- strcpy (interp->result, "snacc info: wrong # args in path");
- return TCL_ERROR;
- }
-
- Tcl_HashEntry *entry = Tcl_FindHashEntry (&files, path.v[0]);
- if (!entry)
- {
- Tcl_AppendResult (interp, "snacc info: no file named \"", path.v[0], "\"", NULL);
- return TCL_ERROR;
- }
-
- ASN1File *file = (ASN1File *)Tcl_GetHashValue (entry);
-
- AsnType *var = (AsnType *)*file;
- for (int i=1; i<path.c; i++)
- if (!(var = var->_getref (path.v[i])))
- {
- Tcl_AppendResult (interp, "snacc info: illegal component \"", path.v[i], "\" in path", NULL);
- return TCL_ERROR;
- }
-
- Tcl_DString desc;
- Tcl_DStringInit (&desc);
- int rc;
- if ((rc = var->_getdesc()->AsnTypeDesc::TclGetDesc (&desc)) == TCL_OK)
- rc = var->TclGetDesc (&desc);
- Tcl_DStringResult (interp, &desc);
- return rc;
-}
-
-//\[sep]----------------------------------------------------------------------------------------------------------------------------
-int SnaccTcl::getval (int argc, char **argv)
-{
- if (argc != 2)
- {
- strcpy (interp->result, "wrong # args: should be \"snacc get path\"");
- return TCL_ERROR;
- }
-
- Args path;
- if (Tcl_SplitList (interp, argv[1], &path.c, &path.v) != TCL_OK)
- return TCL_ERROR;
-
- if (path.c < 1)
- {
- strcpy (interp->result, "snacc get: wrong # args in path");
- return TCL_ERROR;
- }
-
- Tcl_HashEntry *entry = Tcl_FindHashEntry (&files, path.v[0]);
- if (!entry)
- {
- Tcl_AppendResult (interp, "snacc get: no file named \"", path.v[0], "\"", NULL);
- return TCL_ERROR;
- }
-
- ASN1File *file = (ASN1File *)Tcl_GetHashValue (entry);
-
- AsnType *var = (AsnType *)*file;
- for (int i=1; i<path.c; i++)
- if (!(var = var->_getref (path.v[i])))
- {
- Tcl_AppendResult (interp, "snacc get: illegal component \"", path.v[i], "\" in path", NULL);
- return TCL_ERROR;
- }
-
- return var->TclGetVal (interp);
-}
-
-//\[sep]----------------------------------------------------------------------------------------------------------------------------
-int SnaccTcl::test (int argc, char **argv)
-{
- if (argc != 2)
- {
- strcpy (interp->result, "wrong # args: should be \"snacc get path\"");
- return TCL_ERROR;
- }
-
- Args path;
- if (Tcl_SplitList (interp, argv[1], &path.c, &path.v) != TCL_OK)
- return TCL_ERROR;
-
- if (path.c < 1)
- {
- strcpy (interp->result, "snacc get: wrong # args in path");
- return TCL_ERROR;
- }
-
- Tcl_HashEntry *entry = Tcl_FindHashEntry (&files, path.v[0]);
- if (!entry)
- {
- Tcl_AppendResult (interp, "snacc get: no file named \"", path.v[0], "\"", NULL);
- return TCL_ERROR;
- }
-
- ASN1File *file = (ASN1File *)Tcl_GetHashValue (entry);
-
- AsnType *var = (AsnType *)*file;
- for (int i=1; i<path.c; i++)
- if (!(var = var->_getref (path.v[i])))
- {
- Tcl_AppendResult (interp, "snacc test: illegal component \"", path.v[i], "\" in path", NULL);
- return TCL_ERROR;
- }
-
-cout << *var;
- strstream s;
- s << *var;
- s.put ('\0');
- cout << strlen(s.str()) << endl;
- cout << s.str() << endl;
-
- return TCL_OK;
-}
-
-//\[sep]----------------------------------------------------------------------------------------------------------------------------
-int SnaccTcl::setval (int argc, char **argv)
-{
- if (argc != 3)
- {
- strcpy (interp->result, "wrong # args: should be \"snacc set path value\"");
- return TCL_ERROR;
- }
-
- Args path;
- if (Tcl_SplitList (interp, argv[1], &path.c, &path.v) != TCL_OK)
- return TCL_ERROR;
-
- if (path.c < 1)
- {
- strcpy (interp->result, "snacc set: wrong # args in path");
- return TCL_ERROR;
- }
-
- Tcl_HashEntry *entry = Tcl_FindHashEntry (&files, path.v[0]);
- if (!entry)
- {
- Tcl_AppendResult (interp, "snacc set: no file named \"", path.v[0], "\"", NULL);
- return TCL_ERROR;
- }
-
- ASN1File *file = (ASN1File *)Tcl_GetHashValue (entry);
-
- AsnType *var = (AsnType *)*file;
- for (int i=1; i<path.c; i++)
- if (!(var = var->_getref (path.v[i], true)))
- {
- Tcl_AppendResult (interp, "snacc set: illegal component \"", path.v[i], "\" in path", NULL);
- return TCL_ERROR;
- }
-
- return var->TclSetVal (interp, argv[2]);
-}
-
-//\[sep]----------------------------------------------------------------------------------------------------------------------------
-int SnaccTcl::unsetval (int argc, char **argv)
-{
- if (argc != 2)
- {
- strcpy (interp->result, "wrong # args: should be \"snacc unset path\"");
- return TCL_ERROR;
- }
-
- Args path;
- if (Tcl_SplitList (interp, argv[1], &path.c, &path.v) != TCL_OK)
- return TCL_ERROR;
-
- if (path.c == 1)
- {
- strcpy (interp->result, "snacc unset: sorry, but you are not allowed to unset the file itself");
- return TCL_ERROR;
- }
- else if (path.c < 1)
- {
- strcpy (interp->result, "snacc unset: wrong # args in path");
- return TCL_ERROR;
- }
-
- Tcl_HashEntry *entry = Tcl_FindHashEntry (&files, path.v[0]);
- if (!entry)
- {
- Tcl_AppendResult (interp, "snacc unset: no file named \"", path.v[0], "\"", NULL);
- return TCL_ERROR;
- }
-
- ASN1File *file = (ASN1File *)Tcl_GetHashValue (entry);
-
- AsnType *var = (AsnType *)*file;
- for (int i=1; i<path.c-1; i++)
- {
- if (!(var = var->_getref (path.v[i])))
- {
- Tcl_AppendResult (interp, "snacc unset: illegal component \"", path.v[i], "\" in path", NULL);
- return TCL_ERROR;
- }
- }
-
- return var->TclUnsetVal (interp, path.v[path.c-1]);
-}
-
-//\[sep]----------------------------------------------------------------------------------------------------------------------------
-int Snacc_Cmd (ClientData cd, Tcl_Interp *interp, int argc, char **argv)
-{
- SnaccTcl *ed = (SnaccTcl *)cd;
-
-#ifdef DEBUG
- ed->ckip (interp);
-#endif
-
- if (argc < 2)
- {
- strcpy (interp->result, "wrong # args: should be \"snacc option arg ?arg ...?\"");
- return TCL_ERROR;
- }
- --argc;
- argv++;
-
- switch (**argv)
- {
- case 'c':
- if (!strcmp (*argv, "close"))
- return ed->closefile (argc, argv);
- else if (!strcmp (*argv, "create"))
- return ed->create (argc, argv);
- break;
- case 'e':
- if (!strcmp (*argv, "export"))
- return export (interp, argc, argv);
- break;
- case 'f':
- if (!strcmp (*argv, "finfo"))
- return ed->finfo (argc, argv);
- break;
- case 'g':
- if (!strcmp (*argv, "get"))
- return ed->getval (argc, argv);
- break;
- case 'i':
- if (!strcmp (*argv, "import"))
- return import (interp, argc, argv);
- else if (!strcmp (*argv, "info"))
- return ed->info (argc, argv);
- break;
- case 'm':
- if (!strcmp (*argv, "modules"))
- return ed->modulesinfo (argc, argv);
- break;
- case 'o':
- if (!strcmp (*argv, "open"))
- return ed->openfile (argc, argv);
- break;
- case 'r':
- if (!strcmp (*argv, "read"))
- return ed->read (argc, argv);
- break;
- case 's':
- if (!strcmp (*argv, "set"))
- return ed->setval (argc, argv);
- break;
- case 't':
- if (!strcmp (*argv, "test"))
- return ed->test (argc, argv);
- else if (!strcmp (*argv, "type"))
- return ed->typeinfo (argc, argv);
- else if (!strcmp (*argv, "types"))
- return ed->typesinfo (argc, argv);
- break;
- case 'u':
- if (!strcmp (*argv, "unset"))
- return ed->unsetval (argc, argv);
- break;
- case 'w':
- if (!strcmp (*argv, "write"))
- return ed->write (argc, argv);
- break;
- }
- sprintf (interp->result, "bad command option %s: should be close, create, export, finfo, get, import, info, modules, open, read, set, type, types, unset or write", *argv);
-
- return TCL_ERROR;
-}
-
-//\[banner "check for proper initialization & finalization"]------------------------------------------------------------------------
-
-struct check
-{
- int i, j;
-
- check (int);
-
- bool bad();
-};
-
-static int cki;
-
-check::check (int v)
-{
- i = v;
- j = ~i;
-}
-
-#define CK 42
-
-bool check::bad()
-{
- return i != CK || j != ~CK;
-}
-
-check check (CK);
-
-//\[banner "initialization & finalization"]-----------------------------------------------------------------------------------------
-void Snacc_Exit (ClientData data)
-{
- delete (SnaccTcl *)data;
-}
-
-// prohibit function name mangling to enable tkAppInit.c:Tcl_AppInit() to call this function:
-extern "C" int Snacc_Init (Tcl_Interp *interp)
-{
- if (check.bad())
- {
- static const char emsg[] = "linkage error, constructors of static variables didn't get called!\n";
- write (2, emsg, sizeof emsg);
- exit (1);
- }
-
- SnaccTcl *data = new SnaccTcl (interp);
- Tcl_CreateCommand (interp, "snacc", Snacc_Cmd, (ClientData)data, Snacc_Exit);
- return TCL_OK;
-}
-
-#endif // TCL
projects / apple / security.git / blobdiff