diff options
Diffstat (limited to 'script.c')
| -rw-r--r-- | script.c | 384 |
1 files changed, 384 insertions, 0 deletions
diff --git a/script.c b/script.c new file mode 100644 index 0000000..e1a63f1 --- /dev/null +++ b/script.c @@ -0,0 +1,384 @@ +/* Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + +/* "script.c" argv tricks for `#!' scripts. + Author: Aubrey Jaffer */ + +#include <ctype.h> +#include "scm.h" + +#ifdef __IBMC__ +# include <io.h> +#endif /* def __IBMC__ */ + +#ifdef linux +# include <unistd.h> /* for X_OK define */ +#endif /* def linux */ +#ifdef __svr4__ +# include <unistd.h> /* for X_OK define */ +#else +# ifdef __sgi__ +# include <unistd.h> /* for X_OK define */ +# endif /* def __sgi__ */ +#endif /* def __svr4__ */ + +/* Concatentate str2 onto str1 at position n and return concatenated + string if file exists; 0 otherwise. */ + +char *scm_cat_path(str1, str2, n) + char *str1; + const char *str2; + long n; +{ + if (!n) n = strlen(str2); + if (str1) + { + long len = strlen(str1); + str1 = (char *)realloc(str1, (sizet)(len + n + 1)); + if (!str1) return 0L; + strncat(str1 + len, str2, n); + return str1; + } + str1 = (char *)malloc((sizet)(n + 1)); + if (!str1) return 0L; + str1[0] = 0; + strncat(str1, str2, n); + return str1; +} + +char *scm_try_path(path) + char *path; +{ + FILE *f; + /* fprintf(stderr, "Trying %s\n", path);fflush(stderr); */ + if (!path) return 0L; + SYSCALL(f = fopen(path, "r");); + if (f) { + fclose(f); + return path; + } + free(path); + return 0L; +} + +char *scm_sep_init_try(path, sep, initname) + char *path; + const char *sep, *initname; +{ + if (path) path = scm_cat_path(path, sep, 0L); + if (path) path = scm_cat_path(path, initname, 0L); + return scm_try_path(path); +} + +#ifndef LINE_INCREMENTORS +# define LINE_INCREMENTORS '\n' +# ifdef MSDOS +# define WHITE_SPACES ' ':case '\t':case '\r':case '\f':case 26 +# else +# define WHITE_SPACES ' ':case '\t':case '\r':case '\f' +# endif /* def MSDOS */ +#endif /* ndef LINE_INCREMENTORS */ + +#ifndef MAXPATHLEN +# define MAXPATHLEN 80 +#endif /* ndef MAXPATHLEN */ +#ifndef X_OK +# define X_OK 1 +#endif /* ndef X_OK */ + +#ifdef unix +# include <stdio.h> + +char *script_find_executable(name) + const char *name; +{ + char tbuf[MAXPATHLEN]; + int i = 0; + FILE *f; + + /* fprintf(stderr, "s_f_e checking access %s ->%d\n", name, access(name, X_OK)); fflush(stderr); */ + if (access(name, X_OK)) return 0L; + f = fopen(name, "r"); + if (!f) return 0L; + if ((fgetc(f)=='#') && (fgetc(f)=='!')) { + while (1) switch (tbuf[i++] = fgetc(f)) { + case /*WHITE_SPACES*/ ' ':case '\t':case '\r':case '\f': + case EOF: + tbuf[--i] = 0; + fclose(f); + return scm_cat_path(0L, tbuf, 0L); + } + } + fclose(f); + return scm_cat_path(0L, name, 0L); +} +#endif /* unix */ + +#ifdef MSDOS + +# define DEFAULT_PATH "C:\\DOS" +# define PATH_DELIMITER ';' +# define ABSOLUTE_FILENAME_P(fname) ((fname[0] == '\\') \ + || (fname[0] && (fname[1] == ':'))) + +char *dld_find_executable(file) + const char *file; +{ + /* fprintf(stderr, "dld_find_executable %s -> %s\n", file, scm_cat_path(0L, file, 0L)); fflush(stderr); */ + return scm_cat_path(0L, file, 0L); +} +#endif /* def MSDOS */ + +/* Given dld_find_executable()'s best guess for the pathname of this + executable, find (and verify the existence of) initname in the + implementation-vicinity of this program. Returns a newly allocated + string if successful, 0 if not */ + +char *scm_find_impl_file(exec_path, generic_name, initname, sep) + char *exec_path; + const char *generic_name, *initname, *sep; +{ + char *sepptr = strrchr(exec_path, sep[0]); + char *extptr = exec_path + strlen(exec_path); + char *path = 0; + /* fprintf(stderr, "dld_find_e %s\n", exec_path); fflush(stderr); */ + if (sepptr) { + long sepind = sepptr - exec_path + 1L; + + /* In case exec_path is in the source directory, look first in + exec_path's directory. */ + path = scm_cat_path(0L, exec_path, sepind - 1L); + path = scm_sep_init_try(path, sep, initname); + if (path) return path; + +#ifdef MSDOS + if (!strcmp(extptr - 4, ".exe") || !strcmp(extptr - 4, ".com") || + !strcmp(extptr - 4, ".EXE") || !strcmp(extptr - 4, ".COM")) + extptr = extptr - 4; +#endif /* def MSDOS */ + + if (generic_name && + !strncmp(exec_path + sepind, generic_name, extptr - exec_path)) + generic_name = 0; + + /* If exec_path is in directory "exe" or "bin": */ + path = scm_cat_path(0L, exec_path, sepind - 1L); + sepptr = path + sepind - 4; + if (!strcmp(sepptr, "exe") || !strcmp(sepptr, "bin") || + !strcmp(sepptr, "EXE") || !strcmp(sepptr, "BIN")) { + char *peer; + + /* Look for initname in peer directory "lib". */ + if (path) { + strncpy(sepptr, "lib", 3); + path = scm_sep_init_try(path, sep, initname); + if (path) return path; + } + + /* Look for initname in peer directories "lib" and "src" in + subdirectory with the name of the executable (sans any type + extension like .EXE). */ + for(peer="lib";!0;peer="src") { + path = scm_cat_path(0L, exec_path, extptr - exec_path + 0L); + if (path) { + strncpy(path + sepind - 4, peer, 3); + path[extptr - exec_path] = 0; + path = scm_sep_init_try(path, sep, initname); + if (path) return path; + } + if (!strcmp(peer,"src")) break; + } + + if (generic_name) { + + /* Look for initname in peer directories "lib" and "src" in + subdirectory with the generic name. */ + for(peer="lib";!0;peer="src") { + path = scm_cat_path(0L, exec_path, sepind); + if (path) { + strncpy(path + sepind - 4, "lib", 3); + path = scm_cat_path(path, generic_name, 0L); + path = scm_sep_init_try(path, sep, initname); + if (path) return path; + } + if (!strcmp(peer,"src")) break; + }}} + +#ifdef MSDOS + if (strlen(extptr)) { + /* If exec_path has type extension, look in a subdirectory with + the name of the executable sans the executable file's type + extension. */ + path = scm_cat_path(0L, exec_path, extptr - exec_path + 0L); + path = scm_sep_init_try(path, sep, initname); + if (path) return path; + + if (generic_name) { + + /* Also look in generic_name subdirectory. */ + path = scm_cat_path(0L, exec_path, sepind); + if (path) path = scm_cat_path(path, generic_name, 0L); + path = scm_sep_init_try(path, sep, initname); + if (path) return path; + }} +#endif /* def MSDOS */ + } + else { + + /* We don't have a parse-able exec_path. The only path to try is + just initname. */ + path = scm_cat_path(0L, initname, 0L); + if (path) path = scm_try_path(path); + if (path) return path; + } + return 0L; +} + +char *script_read_arg(f) + FILE *f; +{ + sizet tlen = 1; + int tind = 0, qted = 0, chr; + char *tbuf = (char *)malloc((1 + tlen) * sizeof(char)); + if (!tbuf) return 0L; + while (1) switch (chr = getc(f)) { + case WHITE_SPACES: + continue; + case LINE_INCREMENTORS: + case EOF: + free(tbuf); + return 0L; + default: + goto morearg; + } +morearg: + while (1) { + switch (tbuf[tind++] = chr) { + case WHITE_SPACES: + case LINE_INCREMENTORS: + if (qted) break; + case EOF: goto endarg; + case '!': + if (qted) break; + switch (chr = getc(f)) { + case '#': + if (1==tind) return 0L; + goto endarg; + default: tbuf[tind++] = chr; break; + } + break; + case '"': qted = !qted; tind--; break; + case '\\': + switch (tbuf[tind - 1] = getc(f)) { + case '\n': --tind; break; + case 'n': tbuf[tind - 1] = '\n'; break; + case 'r': tbuf[tind - 1] = '\r'; break; + case 't': tbuf[tind - 1] = '\t'; break; + case 'b': tbuf[tind - 1] = '\b'; break; + /* case '0': tbuf[tind - 1] = '\0'; break; */ + default:; + } + default:; + } + if (tind >= tlen) { + tbuf = (char *)realloc(tbuf, (1 + (2 * tlen)) * sizeof(char)); + if (!tbuf) return 0L; + tlen = 2 * tlen; + } + chr = getc(f); + } +endarg: + tbuf[--tind] = 0; + return tbuf; +} + +int script_meta_arg_P(arg) + char *arg; +{ + if ('\\' != arg[0]) return 0L; +#ifdef MSDOS + return !arg[1]; +#else + switch (arg[1]) { + case 0: + case '%': + case WHITE_SPACES: return !0; + default: return 0L;} +#endif +} + +char **script_process_argv(argc, argv) + int argc; + char **argv; +{ + int nargc = argc, argi = 1, nargi = 1; + char *narg, **nargv; + if (!(argc > 2 && script_meta_arg_P(argv[1]))) return 0L; + if (!(nargv = (char **)malloc((1 + nargc) * sizeof(char*)))) return 0L; + nargv[0] = argv[0]; + while (((argi+1) < argc) && (script_meta_arg_P(argv[argi]))) { + FILE *f = fopen(argv[++argi], "r"); + if (f) { + nargc--; /* to compensate for replacement of '\\' */ + while (1) switch (getc(f)) { + case EOF: return 0L; + default: continue; + case '\n': goto found_args; + } + found_args: while ((narg = script_read_arg(f))) + if (!(nargv = (char **)realloc(nargv, (1 + ++nargc) * sizeof(char*)))) + return 0L; + else nargv[nargi++] = narg; + fclose(f); + nargv[nargi++] = argv[argi++]; + } + } + while (argi <= argc) nargv[nargi++] = argv[argi++]; + return nargv; +} + +int script_count_argv(argv) + char **argv; +{ + int argc = 0; + while (argv[argc]) argc++; + return argc; +} |