#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"
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);
}
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; delete buf; return TCL_ERROR;
}
}
delete hunk;
delete buf;
filesize = encodedLen;
if (!wfn)
ftruncate (wfd, filesize);
return TCL_OK;
}
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)]; 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;
}
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);
}
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;
}
}
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;
}
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;
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);
}
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);
}
int SnaccTcl::read (int argc, char **argv)
{
const char *_typename, *filename;
switch (argc)
{
case 2: _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);
}
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]);
}
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;
}
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;
}
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;
}
}
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;
}
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;
}
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);
}
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;
}
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]);
}
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]);
}
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;
}
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);
void Snacc_Exit (ClientData data)
{
delete (SnaccTcl *)data;
}
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