/* filename.c Copyright (C) 1995-2002 Codemist Ltd */
/*
* Map file-names to expand references to shell variables etc.
* and to provide portability of names across operating systems.
*/
/*
* This code may be used and modified, and redistributed in binary
* or source form, subject to the "CCL Public License", which should
* accompany it. This license is a variant on the BSD license, and thus
* permits use of code derived from this in either open and commercial
* projects: but it does require that updates to this code be made
* available back to the originators of the package.
* Before merging other code in with this or linking this code
* with other packages or libraries please check that the license terms
* of the other material are compatible with those of this.
*/
/* Signature: 1705ecf5 10-Oct-2002 */
static char *look_in_lisp_variable(char *o, int prefix)
{
Lisp_Object nil, var;
/*
* I will start by tagging a '$' (or whatever) on in front of the
* parameter name.
*/
o[0] = (char)prefix;
var = make_undefined_symbol(o);
nil = C_nil;
/*
* make_undefined_symbol() could fail either if we had utterly run out
* of memory or if somebody generated an interrupt (eg ^C) around now. Ugh.
*/
if (exception_pending())
{ flip_exception();
return NULL;
}
/*
* If the variable $name was undefined then I use an empty replacement
* text for it. Otherwise I need to look harder at its value.
*/
if (qvalue(var) == unset_var) return o;
else
{ Header h;
intxx len;
var = qvalue(var);
/*
* Mostly I expect that the value will be a string or symbol.
*/
#ifdef COMMON
if (complex_stringp(var))
{ var = simplify_string(var);
nil = C_nil;
if (exception_pending())
{ flip_exception();
return NULL;
}
}
#endif /* COMMON */
if (symbolp(var))
{ var = get_pname(var);
nil = C_nil;
if (exception_pending())
{ flip_exception();
return NULL;
}
h = vechdr(var);
}
else if (!is_vector(var) ||
type_of_header(h = vechdr(var)) != TYPE_STRING)
return NULL;
len = length_of_header(h) - CELL;
/*
* Copy the characters from the string or from the name of the variable
* into the file-name buffer. There could at present be a crash here
* if the expansion was very very long and overflowed my buffer. Tough
* luck for now - people doing that (maybe) get what they (maybe) deserve.
*/
memcpy(o, (char *)var + (CELL - TAG_VECTOR), (size_t)len);
o = o + len;
return o;
}
}
static void process_file_name(char *filename, char *old, size_t n)
/*
* This procedure maps filenames by expanding some environment
* variables. It is very thoroughly system specific, which is why it
* is in this file. See also LONGEST_LEGAL_FILENAME in "tags.h" for a
* limit on the permitted size of an expanded filename.
* The input (old) is not necessarily properly terminated as a C string,
* so n says how many characters to inspect. Build a converted name
* in filename.
* At present the expansions I allow are:
*
* $xxx (terminated by '.', '/' or '\' with at least one char x)
* ${xxx} (self-terminating)
* First check for a Lisp variable $xxx. If this is set (and is
* a string or a symbol) then its value is used. If not then
* next inspect the environment variable xxx and dump its
* value into the output. If the variable is unset then a check
* is made for the value of a global lisp variable called @xxx,
* and if that exists and is a string or symbol it is used.
* If @xxx is undefined a null string is inserted.
* If one of the variables is defined but has an improper value
* then the whole file-translation fails.
* The use of two Lisp variables makes it possible to control
* precedence between these and shell variables.
*
* ~ ) followed by '.', '/' or '\'
* ~xxx )
* On Unix these try to find home directories using
* getpwuid(getuid()) for '~' and getpwnam() for ~xxx.
* If that fails ~ expands into nothing at all.
* This syntax is only recognised at the very start of a file-name.
* For systems other than Unix this syntax will not be useful and
* should be avoided, however as an experimental place-holder I
* may do things with environment variables called HOME etc.
*
*
* I convert file-names of the form aaa/bbb/ccc.ddd into something
* acceptable to the system being used, even though this may result in
* some native file titles that include '/' characters becoming unavailable.
* The reasoning here is that scripts and programs can then use Unix-like
* names and non-Unix hosts will treat them forgivingly.
*
*
*/
#ifdef __vmsvax__
/*
* This is maybe going to be a mess under VAX/VMS, but I will try
* pretending that is still Unix for now since the VMS C runtime system
* seems prepared to help a little in that case.
*/
#endif /* __vmsvax__ */
{
int32 i, j;
int c;
char *o, *tail;
if (n == 0)
{ *filename = 0;
return; /* deem zero-length name to be illegal */
}
o = filename;
c = *old;
/*
* First I deal with a leading "~"
*/
if (c == '~')
{ old++;
n--;
while (n != 0)
{ c = *old;
if (c == '.' || c == '/' || c == '\\') break;
old++;
n--;
*o++ = (char)c;
}
*o = 0;
/*
* actually deciding what the home directory is is passed down to a
* system-specific call, but it is not to be relied upon especially
* on personal computers.
*/
if (o == filename) /* '~' on its own */
{ get_home_directory(filename, LONGEST_LEGAL_FILENAME);
o = filename + strlen(filename);
}
else
{ get_users_home_directory(filename, LONGEST_LEGAL_FILENAME);
o = filename + strlen(filename);
}
}
/*
* Having copies a user-name across (if there was one) I now copy the
* rest of the file-name, expanding $xxx and ${xxx} as necessary.
*/
while (n != 0)
{ c = *old++;
n--;
/*
* If I find a "$" that is either at the end of the file-name or that is
* immediately followed by ".", "/" or "\" then I will not use it for
* parameter expansion. This at least gives me some help with the RISCOS
* file-name $.abc.def where the "$" is used to indicate the root of the
* current disc.
*/
if (c == '$' && n != 0 &&
(c = *old) != '.' && c != '/' && c != '\\')
{ char *p = o, *w;
/*
* I collect the name of the parameter at the end of my file-name buffer,
* but will over-write it later on when I actually do the expansion.
*/
if (c == '{')
{ old++;
n--;
while (n != 0)
{ c = *old++;
n--;
if (c == '}') break;
*p++ = (char)c;
}
}
else
{ while (n != 0)
{ c = *old;
if (c == '.' || c == '/' || c == '\\') break;
old++;
n--;
*p++ = (char)c;
}
}
*p = 0;
i = strlen(o) + 2;
while (i-- != 0) o[i] = o[i-1];
if ((p = look_in_lisp_variable(o, '$')) != NULL &&
p != o) o = p;
else if ((w = my_getenv(o+1)) != NULL) /* Shell variable? */
{ strcpy(o, w);
o = o + strlen(o);
}
else if ((p = look_in_lisp_variable(o, '@')) != NULL)
o = p;
else
{ *filename = 0; /* return reporting failure */
return;
}
}
else *o++ = (char)c;
}
*o = 0;
#ifdef NOT_TOTALLY_DEBUGGED
term_printf("[temp trace] File-name expands to \"%s\"\n", filename);
#endif
#ifdef MS_DOS
/*
* Now the filename has had $ and ~ prefix things expanded - I "just"
* need to deal with sub-directory representation issues. Specifically I need
* to map "/" separators into "\" so that if a user presents a file
* name such as aaa/bbb/ccc.d it gets passed to the operating system
* as aaa\bbb\ccc.d
* NOte that I enable this code under the heading MS_DOS but really it
* means any file-system (eg Windows too) that uses "\" as its main
* directory separator character.
*/
/*
* I map / characters in MSDOS filenames into \s, so that users
* can give file names with Unix-like slashes as separators if they want.
* People who WANT to use filenames with '/' in them will be hurt.
*/
tail = filename;
while ((j = *tail) != 0)
{ if (j == '/') *tail = '\\';
tail++;
}
/*
* stat and friends do not like directories referred to as "\foo\", so check
* for a trailing slash, being careful to respect directories with names
* like "\" and "a:\".
*/
j = strlen(filename);
if (j > 0 && j != 1 && !(j == 3 && *(filename+1) == ':'))
{
if ( (*(tail - 1) == '\\')) *(tail - 1) = 0;
}
#ifdef __WATCOMC__
/*
* There is a bug in the stat function under some releases of Watcom C, where:
* stat("\\foo\\..", ...);
* fails with errno=-1. So we delete trailing ".." segments.
*/
if (filename[0] == '\\' || filename[1] == ':')
{ j = strlen(filename);
while (filename[j-1] == '.' && filename[j-2] == '.')
{ tail = strrchr(filename, '\\');
/*
* Warning - the aerror0() function sets an internal flag to indicate
* that something went wrong, and then returns. Thus if further processing
* is not valid in one of these cases some explicit control flow (maybe a
* "return") is called for,
*/
if (tail == NULL)
aerror0("Unexpected pathname - this error should never happen");
else *tail = '\0';
tail = strrchr(filename, '\\');
if (tail == NULL)
aerror0("Unexpected pathname - this error should never happen");
else *tail = '\0';
j = strlen(filename);
}
/* Make sure we don't have an empty string or just a drive */
if (j == 0) strcpy(filename,"\\");
else if (j==2 && filename[1] == ':') strcat(filename,"\\");
}
#endif /* __WATCOMC__ */
#ifdef EIGHT_PLUS_THREE
/*
* A *NASTY* hack here. I will explicitly truncate the name down to
* and 8+3 format to keep as much DOS compatibility as I (in)conveniently can.
* This is done here because if a user attempts to open a file with a long
* name Windows 95 will try to honour the request and will then get confused
* if old-style W3.x or DOS utilities made the file with a truncated name.
* I rather think that this ought not to be wanted any more, especially if
* it is possible to accept that raw DOS and Windows before 95 need not
* be supported, but I will leave this in the code just in case!
*/
tail = filename;
eight_plus_three(tail);
while ((j=*tail++)!=0) if (j=='\\' || j==':') eight_plus_three(tail);
#endif /* EIGHT_PLUS_THREE */
#endif /* MS_DOS */
#ifdef MACINTOSH
/*
* Now the filename has had $ and ~ prefix things expanded - I "just"
* need to deal with sub-directory representation issues. Specifically I need
* to map "/" separators into "\" so that if a user presents a file
* name such as aaa/bbb/ccc.d it gets passed to the operating system
* as aaa\bbb\ccc.d
* NOte that I enable this code under the heading MS_DOS but really it
* means any file-system (eg Windows too) that uses "\" as its main
* directory separator character.
*/
/*
* I map '/'characters in Macintosh filenames into ':'s, so that users
* can give file names with Unix-like slashes as separators if they want.
* People who WANT to use filenames with '/' in them will be hurt.
* Furthermore if the name originally had no colons in it a leading colon is
* added, and if it originally started with a '/' (for a Unix fully rooted name)
* then the leading ':' or '/' is removed.
*/
tail = filename;
while ((j = *tail) != 0 && j != ':') tail++;
if (j == 0)
{ memmove(&filename[1], filename, 1+strlen(filename));
filename[0] = ':';
}
if (filename[0] == '/') memmove(filename, &filename[1], strlen(filename));
tail = filename;
while ((j = *tail) != 0)
{ if (j == '/') *tail = ':';
tail++;
}
/*
* I map the string :..: onto just :: to cope with Unix-format references to
* the parent directory
*/
i = 0;
while ((c = filename[i]) != 0)
{ if (c == ':' &&
filename[i+1] == '.' &&
filename[i+2] == '.' &&
filename[i+3] == ':')
{ j = i+1;
do
{ c = filename[j+2];
filename[j++] = c;
} while (c != 0);
}
i++;
}
#endif /* MACINTOSH */
#ifdef RISCOS
/*
* Now the filename has had $ and ~ prefix things expanded - I "just"
* need to deal with sub-directory representation issues.
*/
/*
* The Archimedes is best coped with by re-mapping file names
* so that xxxx.y sometimes becomes y.xxxx
*/
i = strlen(filename);
for (j=i-1; j>=0; j--) if (filename[j] == '.') break;
if (j >= 0) /* No '.' => no possible conversion */
{ tail = &filename[j+1];
if (j == i - 2 || /* one character suffix */
/*
* At present my policy is that any file with a one-character final
* component gets mangled, and that as a special case files of
* the form xxx.lsp, xxx.red, xxx.fsl and xxx.log are also flipped.
*/
strcmp(tail, "lsp") == 0 ||
strcmp(tail, "red") == 0 ||
strcmp(tail, "fsl") == 0 ||
strcmp(tail, "tst") == 0 ||
strcmp(tail, "sl") == 0 ||
strcmp(tail, "log") == 0)
{ int32 k;
char suffix[8];
for (k=j-1; k>=0; k--)
if (filename[k] == '.' || filename[k] == '/') break;
strcpy(suffix, tail);
strcat(suffix, ".");
do filename[--i] = filename[--j]; while (j > k);
memcpy(&filename[k+1], suffix, (size_t)(i - j));
}
}
/*
* Now if in the Unix world I had a component '..' in the file it will
* appear something like //.aaa.bbb or aaa.//.bbb
* Similarly I map an isolated '.' (now an isolated '/') into '@'.
*/
{ int32 k = 0;
j = -1;
c = '/';
for (;;)
{ if (c == '/' || c == 0)
{ if (j == k+1 && filename[k] == '.') filename[k] = '@';
else if (j == k + 2 && filename[k] == '.' && filename[k+1] == '.')
{ int c1;
filename[k++] = '^';
do
{ c1 = filename[k+1];
filename[k++] = c1;
} while (c1 != 0);
}
k = j+1;
}
if (c == 0) break;
j++;
c = filename[j];
}
}
/*
* I map / characters in RISCOS filenames into dots, so that users
* can give file names with Unix-like slashes as separators if they want.
* People who WANT to use filenames with '/' in them will be hurt.
* Note also that when files are created for output an attempt to open
* (e.g.) "arthur.red" will fail unless the directory "red" already
* exists.
*/
tail = filename;
while ((j = *tail) != 0)
{ if (j == '/') *tail = '.';
tail++;
}
if (*filename == '.') /* Deal with fully-rooted Unix filenames */
{ tail[1] = 0;
while (tail != filename)
{ tail--;
tail[1] = tail[0];
}
tail[0] = '$';
}
#endif /* RISCOS */
}
FILE *open_file(char *filename, char *old, size_t n,
char *mode, FILE *old_file)
{
/*
* mode is something like "r" or "w" or "rb", as needed by fopen(),
* and old_file is NULL normally, but can be a (FILE *) to indicate
* the use of freopen rather than fopen.
*/
process_file_name(filename, old, n);
if (*filename == 0) return NULL;
#ifdef NO_BINARY_FOPEN
/*
* On some Unix implementations (I mean DECs version on its MIPS workstations
* and on the microvax I tried) the library does not support "rb" and "wb"
* modes, so I work around that here. Explicit selection of binary file
* access will be needed on some non-Unix operating systems, but should
* never be relevant under Unix, hence my choice of a flag for the conditional
* compilation here.
*/
if (mode[0] == 'w')
{ if (mode[1] == '+') mode = "w+";
else mode = "w";
}
else if (mode[1] == '+') mode = "r+";
else mode = "r"; /* That ought to patch it up */
#endif
if (old_file == NULL) return fopen(filename, mode);
else return freopen(filename, mode, old_file);
}
/* end of filename.c */