/tags/2.3.0/extras/vms.c
C | 422 lines | 292 code | 72 blank | 58 comment | 40 complexity | 2b5efb06671d61f783e03d550f6400e0 MD5 | raw file
Possible License(s): LGPL-2.1, AGPL-1.0
- #include <config.h>
- #include <stdio.h>
- #include <stdlib.h>
- #include <string.h>
- #include <descrip.h>
- #include <starlet.h>
- #include <ssdef.h>
- #include <stsdef.h>
- #include <lnmdef.h>
- #include <libdef.h>
- #include <libfisdef.h>
- #include <lib$routines>
- #include <psldef.h>
- #include <rmsdef.h>
- #include <fabdef.h>
- #include <namdef.h>
- #include <unixlib.h>
- static int error_status = SS$_NORMAL;
- static char error_buffer[256];
- static char getenv_buffer[256];
- typedef struct
- {
- struct dsc$descriptor_s fnmdes;
- struct dsc$descriptor_s imgdes;
- struct dsc$descriptor_s symdes;
- char filename[NAM$C_MAXRSS];
- } vms_dl;
- int vms_dlsym (vms_dl *, void **, int);
- void * lt_dlsym (void *, const char *);
- int lt_dlinit (void)
- {
- return 0;
- }
- char translate_buffer[NAM$C_MAXRSS+1];
- int to_vms_callback(char *name, int type)
- {
- strcpy(translate_buffer, name);
- return 1;
- }
- void * lt_dlopen (const char *filename)
- {
- /*
- * Locates and validates a shareable image. If the caller supplies a
- * path as part of the image name, that's where we look. Note that this
- * includes cases where the image name is a logical name pointing to a full
- * file spec including path. If there is no path, we look at wherever the
- * logical name LTDL_LIBRARY_PATH points (if it exists); it'd normally be a
- * search list logical defined in lt_dladdsearchdir, so it could point to a
- * number of places. As a last resort we look in SYS$SHARE.
- */
- vms_dl *dh;
- int status;
- struct FAB imgfab;
- struct NAM imgnam;
- char defimg[NAM$C_MAXRSS+1];
- char *defpath;
- char local_fspec[NAM$C_MAXRSS+1];
- if (filename == NULL)
- {
- error_status = SS$_UNSUPPORTED;
- return NULL;
- }
- strcpy(local_fspec, filename);
- /*
- * The driver manager will handle a hard-coded path from a .ini file, but
- * only if it's an absolute path in unix syntax. To make those acceptable
- * to lib$find_image_symbol, we have to convert to VMS syntax. N.B. Because
- * of the static buffer, this is not thread-safe, but copying immediately to
- * local storage should limit the damage.
- */
-
- if (filename[0] == '/') {
- int num_translated = decc$to_vms(local_fspec, to_vms_callback, 0, 1);
- if (num_translated == 1) strcpy(local_fspec, translate_buffer);
- }
- dh = (vms_dl *)malloc (sizeof (vms_dl));
- memset( dh, 0, sizeof(vms_dl) );
- if (dh == NULL)
- {
- error_status = SS$_INSFMEM;
- return NULL;
- }
- imgfab = cc$rms_fab;
- imgfab.fab$l_fna = local_fspec;
- imgfab.fab$b_fns = (int) strlen (local_fspec);
- imgfab.fab$w_ifi = 0;
- /* If the logical name LTDL_LIBRARY_PATH does not exist, we'll depend
- * on the image name being a logical name or on the image residing in
- * SYS$SHARE.
- */
- if ( getvmsenv("LTDL_LIBRARY_PATH") == NULL )
- {
- strcpy( defimg, ".EXE" );
- }
- else
- {
- strcpy( defimg, "LTDL_LIBRARY_PATH:.EXE" );
- }
- imgfab.fab$l_dna = defimg;
- imgfab.fab$b_dns = strlen(defimg);
- imgfab.fab$l_fop = FAB$M_NAM;
- imgfab.fab$l_nam = &imgnam;
- imgnam = cc$rms_nam;
- imgnam.nam$l_esa = dh->filename;
- imgnam.nam$b_ess = NAM$C_MAXRSS;
-
- status = sys$parse (&imgfab);
- if (!($VMS_STATUS_SUCCESS(status)))
- {
- /* No luck with LTDL_LIBRARY_PATH; try SYS$SHARE */
- strcpy( defimg, "SYS$SHARE:.EXE" );
- imgfab.fab$b_dns = strlen(defimg);
- status = sys$parse (&imgfab);
- if (!($VMS_STATUS_SUCCESS(status)))
- {
- error_status = status;
- return NULL;
- }
- }
- dh->fnmdes.dsc$b_dtype = DSC$K_DTYPE_T;
- dh->fnmdes.dsc$b_class = DSC$K_CLASS_S;
- dh->fnmdes.dsc$a_pointer = imgnam.nam$l_name;
- dh->fnmdes.dsc$w_length = imgnam.nam$b_name;
- dh->imgdes.dsc$b_dtype = DSC$K_DTYPE_T;
- dh->imgdes.dsc$b_class = DSC$K_CLASS_S;
- dh->imgdes.dsc$a_pointer = dh->filename;
- dh->imgdes.dsc$w_length = imgnam.nam$b_esl;
- /*
- ** Attempt to load a symbol at this stage to
- ** validate that the shared file can be loaded
- */
- lt_dlsym (dh, "Fake_Symbol_Name");
- if (!((error_status ^ LIB$_KEYNOTFOU) & ~7)) error_status = SS$_NORMAL;
- if (!($VMS_STATUS_SUCCESS(error_status)))
- {
- free (dh);
- return NULL;
- }
-
- return dh;
- }
- int lt_dlclose (void *handle)
- {
- free (handle);
- return 0;
- }
- void * lt_dlsym (void *handle, const char *name)
- {
- vms_dl *dh;
- void *ptr;
- int status, flags;
- dh = (vms_dl *)handle;
- if (!dh) return NULL;
- dh->symdes.dsc$b_dtype = DSC$K_DTYPE_T;
- dh->symdes.dsc$b_class = DSC$K_CLASS_S;
- dh->symdes.dsc$a_pointer = (char *) name;
- dh->symdes.dsc$w_length = strlen (name);
- /* firstly attempt with flags set to 0 case insensitive */
- flags = 0;
- status = vms_dlsym (dh, &ptr, flags);
- if (!($VMS_STATUS_SUCCESS(status)))
- {
- /*
- ** Try again with mixed case flag set
- */
- flags = LIB$M_FIS_MIXEDCASE;
- status = vms_dlsym (dh, &ptr, flags);
- if (!($VMS_STATUS_SUCCESS(status)))
- {
- error_status = status;
- return NULL;
- }
- }
- return ptr;
- }
- int vms_dlsym (
- vms_dl *dh,
- void **ptr,
- int flags)
- {
- LIB$ESTABLISH (LIB$SIG_TO_RET);
- return LIB$FIND_IMAGE_SYMBOL (&dh->fnmdes, &dh->symdes, ptr, &dh->imgdes, flags);
- }
- const char *lt_dlerror (void)
- {
- struct dsc$descriptor desc;
- short outlen;
- int status;
- if (($VMS_STATUS_SUCCESS(error_status))) return NULL;
-
- desc.dsc$b_dtype = DSC$K_DTYPE_T;
- desc.dsc$b_class = DSC$K_CLASS_S;
- desc.dsc$a_pointer = error_buffer;
- desc.dsc$w_length = sizeof (error_buffer);
- status = sys$getmsg (error_status, &outlen, &desc, 15, 0);
- if ($VMS_STATUS_SUCCESS(status)) error_buffer[outlen] = '\0';
- else sprintf (error_buffer, "OpenVMS exit status %8X", error_status);
- error_status = SS$_NORMAL;
- return (error_buffer);
- }
- struct itemlist3 {
- unsigned short buflen;
- unsigned short item;
- void *buf;
- unsigned short *retlen;
- };
- int lt_dladdsearchdir (const char *search_dir)
- {
- /*
- * Adds a path to the list of paths where lt_dlopen will look for shareable images.
- * We do this via a user-mode search list logical, adding one more item to the end of
- * the list whenever called.
- */
- $DESCRIPTOR(lib_path_d, "LTDL_LIBRARY_PATH");
- $DESCRIPTOR( proc_table_d, "LNM$PROCESS_TABLE" );
- unsigned int status = 0;
- unsigned char accmode = 0, lnm_exists = 1;
- int index = 0, max_index = 0;
- struct itemlist3 trnlnmlst[4] = {{sizeof(accmode), LNM$_ACMODE, &accmode, 0},
- {sizeof(max_index), LNM$_MAX_INDEX, &max_index, 0},
- {0, 0, 0, 0},
- {0, 0, 0, 0}};
- struct itemlist3 *crelnmlst;
- struct eqvarray {
- char eqvname[256];
- };
- struct eqvarray *eqvlist;
- /* First just check to see whether the logical name exists and how many equivalence
- * names there are.
- */
- status = SYS$TRNLNM ( NULL,
- &proc_table_d,
- &lib_path_d,
- NULL,
- trnlnmlst);
- /* If the logical name doesn't exist or exists at a privilege mode or table I
- * can't even look at, then I'll want to proceed with creating my user-mode logical.
- */
- if ( status == SS$_NOLOGNAM || status == SS$_NOPRIV ) {
- status = SS$_NORMAL;
- lnm_exists = 0; /* skip further translation attempts */
- max_index = 0;
- }
- if (!$VMS_STATUS_SUCCESS(status)) {
- error_status = status;
- return -1;
- }
- /* Also skip further translation if the first translation exists in any mode other
- * than user mode; we want to stick user mode logicals in front of these.
- */
- if ( accmode != PSL$C_USER ) {
- lnm_exists = 0;
- max_index = 0;
- }
- /* Allocate an item list for logical name creation and an array of equivalence
- * name buffers.
- */
- crelnmlst = (struct itemlist3 *) malloc( sizeof(struct itemlist3) * (max_index + 3) );
- if (crelnmlst == NULL) { error_status = SS$_INSFMEM; return -1; }
- eqvlist = (struct eqvarray *) malloc( sizeof(struct eqvarray) * (max_index + 2) );
- if (eqvlist == NULL) { error_status = SS$_INSFMEM; return -1; }
- trnlnmlst[1].buflen = sizeof(index);
- trnlnmlst[1].item = LNM$_INDEX;
- trnlnmlst[1].buf = &index;
- trnlnmlst[1].retlen = NULL;
- trnlnmlst[2].buflen = sizeof(eqvlist[0].eqvname);
- trnlnmlst[2].item = LNM$_STRING;
- /* The loops iterates over the search list index, getting the translation
- * for each index and storing it in the item list for re-creation.
- */
- for (index = 0; index <= max_index && lnm_exists; index++ ) {
- /* Wire the input buffer for translation to the output buffer for creation */
- trnlnmlst[2].buf = &eqvlist[index].eqvname;
- crelnmlst[index].buf = &eqvlist[index].eqvname;
- trnlnmlst[2].retlen = &crelnmlst[index].buflen;
- status = SYS$TRNLNM ( NULL,
- &proc_table_d,
- &lib_path_d,
- NULL,
- trnlnmlst);
- if (!$VMS_STATUS_SUCCESS(status)) {
- error_status = status;
- free(crelnmlst);
- free(eqvlist);
- return -1;
- }
- /* If we come across a non-user-mode translation, back up and get out
- * because we don't want to recreate those in user mode.
- */
- if ( accmode != PSL$C_USER ) {
- index--;
- break;
- }
- crelnmlst[index].item = LNM$_STRING;
- crelnmlst[index].retlen = NULL;
- }
- /* At this point we have captured all the existing translations (if
- * any) and stored them in the item list for re-creation of the logical
- * name. All that's left is to add the new item to the end of the list
- * and terminate the list.
- */
- crelnmlst[index].buflen = strlen(search_dir);
- crelnmlst[index].item = LNM$_STRING;
- crelnmlst[index].buf = (char *) search_dir;
- crelnmlst[index].retlen = NULL;
- crelnmlst[index+1].buflen = 0;
- crelnmlst[index+1].item = 0;
- crelnmlst[index+1].buf = NULL;
- crelnmlst[index+1].retlen = NULL;
- accmode = PSL$C_USER;
- status = SYS$CRELNM( NULL,
- &proc_table_d,
- &lib_path_d,
- &accmode,
- crelnmlst );
- if (!$VMS_STATUS_SUCCESS(status)) {
- error_status = status;
- free(crelnmlst);
- free(eqvlist);
- return -1;
- }
- free(crelnmlst);
- free(eqvlist);
- error_status = SS$_NORMAL;
- return 0;
- }
- char * getvmsenv (char *symbol)
- {
- int status;
- unsigned short cbvalue;
- $DESCRIPTOR (logicalnametable, "LNM$FILE_DEV");
- struct dsc$descriptor_s logicalname;
- struct itemlist3 itemlist[2];
- logicalname.dsc$w_length = strlen (symbol);
- logicalname.dsc$b_dtype = DSC$K_DTYPE_T;
- logicalname.dsc$b_class = DSC$K_CLASS_S;
- logicalname.dsc$a_pointer = symbol;
- itemlist[0].buflen = sizeof (getenv_buffer) -1;
- itemlist[0].item = LNM$_STRING;
- itemlist[0].buf = getenv_buffer;
- itemlist[0].retlen = &cbvalue;
- itemlist[1].buflen = 0;
- itemlist[1].item = 0;
- itemlist[1].buf = 0;
- itemlist[1].retlen = 0;
- status = SYS$TRNLNM (0, &logicalnametable, &logicalname, 0, itemlist);
- if (!($VMS_STATUS_SUCCESS(status))) return NULL;
- if (cbvalue > 0)
- {
- getenv_buffer[cbvalue] = '\0';
- return getenv_buffer;
- }
- return NULL;
- }