pathname.c revision 5dfecf96 
1/*
2 * Copyright (c) 2001 by The XFree86 Project, Inc.
3 *
4 * Permission is hereby granted, free of charge, to any person obtaining a
5 * copy of this software and associated documentation files (the "Software"),
6 * to deal in the Software without restriction, including without limitation
7 * the rights to use, copy, modify, merge, publish, distribute, sublicense,
8 * and/or sell copies of the Software, and to permit persons to whom the
9 * Software is furnished to do so, subject to the following conditions:
10 *
11 * The above copyright notice and this permission notice shall be included in
12 * all copies or substantial portions of the Software.
13 *
14 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
17 * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
18 * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
19 * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
20 * SOFTWARE.
21 *
22 * Except as contained in this notice, the name of the XFree86 Project shall
23 * not be used in advertising or otherwise to promote the sale, use or other
24 * dealings in this Software without prior written authorization from the
25 * XFree86 Project.
26 *
27 * Author: Paulo César Pereira de Andrade
28 */
29
30/* $XFree86: xc/programs/xedit/lisp/pathname.c,v 1.17tsi Exp $ */
31
32#include <stdio.h>	/* including dirent.h first may cause problems */
33#include <sys/types.h>
34#include <dirent.h>
35#include <errno.h>
36#include <sys/stat.h>
37#include "lisp/pathname.h"
38#include "lisp/private.h"
39
40#define NOREAD_SKIP	0
41#define NOREAD_ERROR	1
42
43/*
44 * Initialization
45 */
46LispObj *Oparse_namestring, *Kerror, *Kabsolute, *Krelative, *Kskip;
47
48/*
49 * Implementation
50 */
51void
52LispPathnameInit(void)
53{
54    Kerror		= KEYWORD("ERROR");
55    Oparse_namestring	= STATIC_ATOM("PARSE-NAMESTRING");
56    Kabsolute		= KEYWORD("ABSOLUTE");
57    Krelative		= KEYWORD("RELATIVE");
58}
59
60static int
61glob_match(char *cmp1, char *cmp2)
62/*
63 * Note: this code was written from scratch, and may generate incorrect
64 * results for very complex glob masks.
65 */
66{
67    for (;;) {
68	while (*cmp1 && *cmp1 == *cmp2) {
69	    ++cmp1;
70	    ++cmp2;
71	}
72	if (*cmp2) {
73	    if (*cmp1 == '*') {
74		while (*cmp1 == '*')
75		    ++cmp1;
76		if (*cmp1) {
77		    int count = 0, settmp = 1;
78		    char *tmp = cmp2, *sav2;
79
80		    while (*cmp1 && *cmp1 == '?') {
81			++cmp1;
82			++count;
83		    }
84
85		    /* need to recurse here to make sure
86		     * all cases are tested.
87		     */
88		    while (*cmp2 && *cmp2 != *cmp1)
89			++cmp2;
90		    if (!*cmp1 && cmp2 - tmp < count)
91			return (0);
92		    sav2 = cmp2;
93
94		    /* if recursive calls fails, make sure all '?'
95		     * following '*' are processed */
96		    while (*sav2 && sav2 - tmp < count)
97			++sav2;
98
99		    for (; *cmp2;) {
100			if (settmp) /* repeated letters: *?o? => boot, root */
101			    tmp = cmp2;
102			else
103			    settmp = 1;
104			while (*cmp2 && *cmp2 != *cmp1)
105			    ++cmp2;
106			if (cmp2 - tmp < count) {
107			    if (*cmp2)
108				++cmp2;
109			    settmp = 0;
110			    continue;
111			}
112			if (*cmp2) {
113			    if (glob_match(cmp1, cmp2))
114				return (1);
115			    ++cmp2;
116			}
117		    }
118		    cmp2 = sav2;
119		}
120		else {
121		    while (*cmp2)
122			++cmp2;
123		    break;
124		}
125	    }
126	    else if (*cmp1 == '?') {
127		while (*cmp1 == '?' && *cmp2) {
128		    ++cmp1;
129		    ++cmp2;
130		}
131		continue;
132	    }
133	    else
134		break;
135	}
136	else {
137	    while (*cmp1 == '*')
138		++cmp1;
139	    break;
140	}
141    }
142
143    return (*cmp1 == '\0' && *cmp2 == '\0');
144}
145
146/*
147 * Since directory is a function to be extended by the implementation,
148 * current extensions are:
149 *	all		=> list files and directories
150 *			   it is an error to call
151 *			   (directory "<pathname-spec>/" :all t)
152 *			   if non nil, it is like the shell command
153 *			   echo <pathname-spec>, but normally, not in the
154 *			   same order, as the code does not sort the result.
155 *		!=nil	=> list files and directories
156 * (default)	nil	=> list only files, or only directories if
157 *			   <pathname-spec> ends with PATH_SEP char.
158 *	if-cannot-read	=> if opendir fails on a directory
159 *		:error	=> generate an error
160 * (default)	:skip	=> skip search in this directory
161 */
162LispObj *
163Lisp_Directory(LispBuiltin *builtin)
164/*
165 directory pathname &key all if-cannot-read
166 */
167{
168    GC_ENTER();
169    DIR *dir;
170    struct stat st;
171    struct dirent *ent;
172    int length, listdirs, i, ndirs, nmatches;
173    char name[PATH_MAX + 1], path[PATH_MAX + 2], directory[PATH_MAX + 2];
174    char *sep, *base, *ptr, **dirs, **matches,
175	  dot[] = {'.', PATH_SEP, '\0'},
176	  dotdot[] = {'.', '.', PATH_SEP, '\0'};
177    int cannot_read;
178
179    LispObj *pathname, *all, *if_cannot_read, *result, *cons, *object;
180
181    if_cannot_read = ARGUMENT(2);
182    all = ARGUMENT(1);
183    pathname = ARGUMENT(0);
184    result = NIL;
185
186    cons = NIL;
187
188    if (if_cannot_read != UNSPEC) {
189	if (!KEYWORDP(if_cannot_read) ||
190	    (if_cannot_read != Kskip &&
191	     if_cannot_read != Kerror))
192	    LispDestroy("%s: bad :IF-CANNOT-READ %s",
193			STRFUN(builtin), STROBJ(if_cannot_read));
194	if (if_cannot_read != Kskip)
195	    cannot_read = NOREAD_SKIP;
196	else
197	    cannot_read = NOREAD_ERROR;
198    }
199    else
200	cannot_read = NOREAD_SKIP;
201
202    if (PATHNAMEP(pathname))
203	pathname = CAR(pathname->data.pathname);
204    else if (STREAMP(pathname) && pathname->data.stream.type == LispStreamFile)
205	pathname = CAR(pathname->data.stream.pathname->data.pathname);
206    else if (!STRINGP(pathname))
207	LispDestroy("%s: %s is not a pathname",
208		    STRFUN(builtin), STROBJ(pathname));
209
210    strncpy(name, THESTR(pathname), sizeof(name) - 1);
211    name[sizeof(name) - 1] = '\0';
212    length = strlen(name);
213    if (length < STRLEN(pathname))
214	LispDestroy("%s: pathname too long %s",
215		    STRFUN(builtin), name);
216
217    if (length == 0) {
218	if (getcwd(path, sizeof(path) - 2) == NULL)
219	    LispDestroy("%s: getcwd(): %s", STRFUN(builtin), strerror(errno));
220	length = strlen(path);
221	if (!length || path[length - 1] != PATH_SEP) {
222	    path[length++] = PATH_SEP;
223	    path[length] = '\0';
224	}
225	result = APPLY1(Oparse_namestring, LSTRING(path, length));
226	GC_LEAVE();
227
228	return (result);
229    }
230
231    if (name[length - 1] == PATH_SEP) {
232	listdirs = 1;
233	if (length > 1) {
234	    --length;
235	    name[length] = '\0';
236	}
237    }
238    else
239	listdirs = 0;
240
241    if (name[0] != PATH_SEP) {
242	if (getcwd(path, sizeof(path) - 2) == NULL)
243	    LispDestroy("%s: getcwd(): %s", STRFUN(builtin), strerror(errno));
244	length = strlen(path);
245	if (!length || path[length - 1] != PATH_SEP) {
246	    path[length++] = PATH_SEP;
247	    path[length] = '\0';
248	}
249    }
250    else
251	path[0] = '\0';
252
253    result = NIL;
254
255    /* list intermediate directories */
256    matches = NULL;
257    nmatches = 0;
258    dirs = LispMalloc(sizeof(char*));
259    ndirs = 1;
260    if (snprintf(directory, sizeof(directory), "%s%s%c",
261		 path, name, PATH_SEP) > PATH_MAX)
262	LispDestroy("%s: pathname too long %s", STRFUN(builtin), directory);
263
264    /* Remove ../ */
265    sep = directory;
266    for (sep = strstr(sep, dotdot); sep; sep = strstr(sep, dotdot)) {
267	if (sep <= directory + 1)
268	    strcpy(directory, sep + 2);
269	else if (sep[-1] == PATH_SEP) {
270	    for (base = sep - 2; base > directory; base--)
271		if (*base == PATH_SEP)
272		    break;
273	    strcpy(base, sep + 2);
274	    sep = base;
275	}
276	else
277	    ++sep;
278    }
279
280    /* Remove "./" */
281    sep = directory;
282    for (sep = strstr(sep, dot); sep; sep = strstr(sep, dot)) {
283	if (sep == directory || sep[-1] == PATH_SEP)
284	    strcpy(sep, sep + 2);
285	else
286	    ++sep;
287    }
288
289    /* This will happen when there are too many '../'  in the path */
290    if (directory[1] == '\0') {
291	directory[1] = PATH_SEP;
292	directory[2] = '\0';
293    }
294
295    base = directory;
296    sep = strchr(base + 1, PATH_SEP);
297    dirs[0] = LispMalloc(2);
298    dirs[0][0] = PATH_SEP;
299    dirs[0][1] = '\0';
300
301    for (base = directory + 1, sep = strchr(base, PATH_SEP); ;
302	 base = sep + 1, sep = strchr(base, PATH_SEP)) {
303	*sep = '\0';
304	if (sep[1] == '\0')
305	    sep = NULL;
306	length = strlen(base);
307	if (length == 0) {
308	    if (sep)
309		*sep = PATH_SEP;
310	    else
311		break;
312	    continue;
313	}
314
315	for (i = 0; i < ndirs; i++) {
316	    length = strlen(dirs[i]);
317	    if (length > 1)
318		dirs[i][length - 1] = '\0';		/* remove trailing / */
319	    if ((dir = opendir(dirs[i])) != NULL) {
320		(void)readdir(dir);	/* "." */
321		(void)readdir(dir);	/* ".." */
322		if (length > 1)
323		    dirs[i][length - 1] = PATH_SEP;	/* add trailing / again */
324
325		snprintf(path, sizeof(path), "%s", dirs[i]);
326		length = strlen(path);
327		ptr = path + length;
328
329		while ((ent = readdir(dir)) != NULL) {
330		    int isdir;
331		    unsigned d_namlen = strlen(ent->d_name);
332
333		    if (length + d_namlen + 2 < sizeof(path))
334			strcpy(ptr, ent->d_name);
335		    else {
336			closedir(dir);
337			LispDestroy("%s: pathname too long %s",
338				    STRFUN(builtin), dirs[i]);
339		    }
340
341		    if (stat(path, &st) != 0)
342			isdir = 0;
343		    else
344			isdir = S_ISDIR(st.st_mode);
345
346		    if (all != UNSPEC || ((isdir && (listdirs || sep)) ||
347					  (!listdirs && !sep && !isdir))) {
348			if (glob_match(base, ent->d_name)) {
349			    if (isdir) {
350				length = strlen(ptr);
351				ptr[length++] = PATH_SEP;
352				ptr[length] = '\0';
353			    }
354			    /* XXX won't closedir on memory allocation failure! */
355			    matches = LispRealloc(matches, sizeof(char*) *
356						  nmatches + 1);
357			    matches[nmatches++] = LispStrdup(ptr);
358			}
359		    }
360		}
361		closedir(dir);
362
363		if (nmatches == 0) {
364		    if (sep || !listdirs || *base) {
365			LispFree(dirs[i]);
366			if (i + 1 < ndirs)
367			    memmove(dirs + i, dirs + i + 1,
368				    sizeof(char*) * (ndirs - (i + 1)));
369			--ndirs;
370			--i;		    /* XXX playing with for loop */
371		    }
372		}
373		else {
374		    int j;
375
376		    length = strlen(dirs[i]);
377		    if (nmatches > 1) {
378			dirs = LispRealloc(dirs, sizeof(char*) *
379					   (ndirs + nmatches));
380			if (i + 1 < ndirs)
381			    memmove(dirs + i + nmatches, dirs + i + 1,
382				    sizeof(char*) * (ndirs - (i + 1)));
383		    }
384		    for (j = 1; j < nmatches; j++) {
385			dirs[i + j] = LispMalloc(length +
386						 strlen(matches[j]) + 1);
387			sprintf(dirs[i + j], "%s%s", dirs[i], matches[j]);
388		    }
389		    dirs[i] = LispRealloc(dirs[i],
390					  length + strlen(matches[0]) + 1);
391		    strcpy(dirs[i] + length, matches[0]);
392		    i += nmatches - 1;	/* XXX playing with for loop */
393		    ndirs += nmatches - 1;
394
395		    for (j = 0; j < nmatches; j++)
396			LispFree(matches[j]);
397		    LispFree(matches);
398		    matches = NULL;
399		    nmatches = 0;
400		}
401	    }
402	    else {
403		if (cannot_read == NOREAD_ERROR)
404		    LispDestroy("%s: opendir(%s): %s",
405				STRFUN(builtin), dirs[i], strerror(errno));
406		else {
407		    LispFree(dirs[i]);
408		    if (i + 1 < ndirs)
409			memmove(dirs + i, dirs + i + 1,
410				sizeof(char*) * (ndirs - (i + 1)));
411		    --ndirs;
412		    --i;	    /* XXX playing with for loop */
413		}
414	    }
415	}
416	if (sep)
417	    *sep = PATH_SEP;
418	else
419	    break;
420    }
421
422    for (i = 0; i < ndirs; i++) {
423	object = APPLY1(Oparse_namestring, STRING2(dirs[i]));
424	if (result == NIL) {
425	    result = cons = CONS(object, NIL);
426	    GC_PROTECT(result);
427	}
428	else {
429	    RPLACD(cons, CONS(object, NIL));
430	    cons = CDR(cons);
431	}
432    }
433    LispFree(dirs);
434    GC_LEAVE();
435
436    return (result);
437}
438
439LispObj *
440Lisp_ParseNamestring(LispBuiltin *builtin)
441/*
442 parse-namestring object &optional host defaults &key start end junk-allowed
443 */
444{
445    GC_ENTER();
446    LispObj *result;
447
448    LispObj *object, *host, *defaults, *ostart, *oend, *junk_allowed;
449
450    junk_allowed = ARGUMENT(5);
451    oend = ARGUMENT(4);
452    ostart = ARGUMENT(3);
453    defaults = ARGUMENT(2);
454    host = ARGUMENT(1);
455    object = ARGUMENT(0);
456
457    if (host == UNSPEC)
458	host = NIL;
459    if (defaults == UNSPEC)
460	defaults = NIL;
461
462    RETURN_COUNT = 1;
463    if (STREAMP(object)) {
464	if (object->data.stream.type == LispStreamFile)
465	    object = object->data.stream.pathname;
466	/* else just check for JUNK-ALLOWED... */
467    }
468    if (PATHNAMEP(object)) {
469	RETURN(0) = FIXNUM(0);
470	return (object);
471    }
472
473    if (host != NIL) {
474	CHECK_STRING(host);
475    }
476    if (defaults != NIL) {
477	if (!PATHNAMEP(defaults)) {
478	    defaults = APPLY1(Oparse_namestring, defaults);
479	    GC_PROTECT(defaults);
480	}
481    }
482
483    result = NIL;
484    if (STRINGP(object)) {
485	LispObj *cons, *cdr;
486	char *name = THESTR(object), *ptr, *str, data[PATH_MAX + 1],
487	      string[PATH_MAX + 1], *namestr, *typestr, *send;
488	long start, end, length, alength, namelen, typelen;
489
490	LispCheckSequenceStartEnd(builtin, object, ostart, oend,
491				  &start, &end, &length);
492	alength = end - start;
493
494	if (alength > sizeof(data) - 1)
495	    LispDestroy("%s: string %s too large",
496			STRFUN(builtin), STROBJ(object));
497	memcpy(data, name + start, alength);
498#ifndef KEEP_EXTRA_PATH_SEP
499	ptr = data;
500	send = ptr + alength;
501	while (ptr < send) {
502	    if (*ptr++ == PATH_SEP) {
503		for (str = ptr; str < send && *str == PATH_SEP; str++)
504		    ;
505		if (str - ptr) {
506		    memmove(ptr, str, alength - (str - data));
507		    alength -= str - ptr;
508		    send -= str - ptr;
509		}
510	    }
511	}
512#endif
513	data[alength] = '\0';
514	memcpy(string, data, alength + 1);
515
516	if (PATHNAMEP(defaults))
517	    defaults = defaults->data.pathname;
518
519	/* string name */
520	result = cons = CONS(NIL, NIL);
521	GC_PROTECT(result);
522
523	/* host */
524	if (defaults != NIL)
525	    defaults = CDR(defaults);
526	cdr = defaults == NIL ? NIL : CAR(defaults);
527	RPLACD(cons, CONS(cdr, NIL));
528	cons = CDR(cons);
529
530	/* device */
531	if (defaults != NIL)
532	    defaults = CDR(defaults);
533	cdr = defaults == NIL ? NIL : CAR(defaults);
534	RPLACD(cons, CONS(cdr, NIL));
535	cons = CDR(cons);
536
537	/* directory */
538	if (defaults != NIL)
539	    defaults = CDR(defaults);
540	if (*data == PATH_SEP)
541	    cdr = CONS(Kabsolute, NIL);
542	else
543	    cdr = CONS(Krelative, NIL);
544	RPLACD(cons, CONS(cdr, NIL));
545	cons = CDR(cons);
546	/* directory components */
547	ptr = data;
548	send = data + alength;
549	if (*ptr == PATH_SEP)
550	    ++ptr;
551	for (str = ptr; str < send; str++) {
552	    if (*str == PATH_SEP)
553		break;
554	}
555	while (str < send) {
556	    *str++ = '\0';
557	    if (str - ptr > NAME_MAX)
558		LispDestroy("%s: directory name too long %s",
559			    STRFUN(builtin), ptr);
560	    RPLACD(cdr, CONS(LSTRING(ptr, str - ptr - 1), NIL));
561	    cdr = CDR(cdr);
562	    for (ptr = str; str < send; str++) {
563		if (*str == PATH_SEP)
564		    break;
565	    }
566	}
567	if (str - ptr > NAME_MAX)
568	    LispDestroy("%s: file name too long %s", STRFUN(builtin), ptr);
569	if (CAAR(cons) == Krelative &&
570	    defaults != NIL && CAAR(defaults) == Kabsolute) {
571	    /* defaults specify directory and pathname doesn't */
572	    char *tstring;
573	    long dlength, tlength;
574	    LispObj *dir = CDAR(defaults);
575
576	    for (dlength = 1; CONSP(dir); dir = CDR(dir))
577		dlength += STRLEN(CAR(dir)) + 1;
578	    if (alength + dlength < PATH_MAX) {
579		memmove(data + dlength, data, alength + 1);
580		memmove(string + dlength, string, alength + 1);
581		alength += dlength;
582		ptr += dlength;
583		send += dlength;
584		CAAR(cons) = Kabsolute;
585		for (dir = CDAR(defaults), cdr = CAR(cons);
586		     CONSP(dir);
587		     dir = CDR(dir)) {
588		    RPLACD(cdr, CONS(CAR(dir), CDR(cdr)));
589		    cdr = CDR(cdr);
590		}
591		dir = CDAR(defaults);
592		data[0] = string[0] = PATH_SEP;
593		for (dlength = 1; CONSP(dir); dir = CDR(dir)) {
594		    tstring = THESTR(CAR(dir));
595		    tlength = STRLEN(CAR(dir));
596		    memcpy(data + dlength, tstring, tlength);
597		    memcpy(string + dlength, tstring, tlength);
598		    dlength += tlength;
599		    data[dlength] = string[dlength] = PATH_SEP;
600		    ++dlength;
601		}
602	    }
603	}
604
605	/* name */
606	if (defaults != NIL)
607	    defaults = CDR(defaults);
608	cdr = defaults == NIL ? NIL : CAR(defaults);
609	for (typelen = 0, str = ptr; str < send; str++) {
610	    if (*str == PATH_TYPESEP) {
611		typelen = 1;
612		break;
613	    }
614	}
615	if (*ptr)
616	    cdr = LSTRING(ptr, str - ptr);
617	if (STRINGP(cdr)) {
618	    namestr = THESTR(cdr);
619	    namelen = STRLEN(cdr);
620	}
621	else {
622	    namestr = "";
623	    namelen = 0;
624	}
625	RPLACD(cons, CONS(cdr, NIL));
626	cons = CDR(cons);
627
628	/* type */
629	if (defaults != NIL)
630	    defaults = CDR(defaults);
631	cdr = defaults == NIL ? NIL : CAR(defaults);
632	ptr = str + typelen;
633	if (*ptr)
634	    cdr = LSTRING(ptr, send - ptr);
635	if (STRINGP(cdr)) {
636	    typestr = THESTR(cdr);
637	    typelen = STRLEN(cdr);
638	}
639	else {
640	    typestr = "";
641	    typelen = 0;
642	}
643	RPLACD(cons, CONS(cdr, NIL));
644	cons = CDR(cons);
645
646	/* version */
647	if (defaults != NIL)
648	    defaults = CDR(defaults);
649	cdr = defaults == NIL ? NIL : CAR(defaults);
650	RPLACD(cons, CONS(cdr, NIL));
651
652	/* string representation, must be done here to use defaults */
653	for (ptr = string + alength; ptr >= string; ptr--) {
654	    if (*ptr == PATH_SEP)
655		break;
656	}
657	if (ptr >= string)
658	    ++ptr;
659	else
660	    ptr = string;
661	*ptr = '\0';
662
663	length = ptr - string;
664
665	alength = namelen;
666	if (alength) {
667	    if (length + alength + 2 > sizeof(string))
668		alength = sizeof(string) - length - 2;
669	    memcpy(string + length, namestr, alength);
670	    length += alength;
671	}
672
673	alength = typelen;
674	if (alength) {
675	    if (length + 2 < sizeof(string))
676		string[length++] = PATH_TYPESEP;
677	    if (length + alength + 2 > sizeof(string))
678		alength = sizeof(string) - length - 2;
679	    memcpy(string + length, typestr, alength);
680	    length += alength;
681	}
682	string[length] = '\0';
683
684	RPLACA(result,  LSTRING(string, length));
685	RETURN(0) = FIXNUM(end);
686
687	result = PATHNAME(result);
688    }
689    else if (junk_allowed == UNSPEC || junk_allowed == NIL)
690	LispDestroy("%s: bad argument %s", STRFUN(builtin), STROBJ(object));
691    else
692	RETURN(0) = NIL;
693
694    GC_LEAVE();
695
696    return (result);
697}
698
699LispObj *
700Lisp_MakePathname(LispBuiltin *builtin)
701/*
702 make-pathname &key host device directory name type version defaults
703 */
704{
705    GC_ENTER();
706    int length, alength;
707    char *string, pathname[PATH_MAX + 1];
708    LispObj *result, *cdr, *cons;
709
710    LispObj *host, *device, *directory, *name, *type, *version, *defaults;
711
712    defaults = ARGUMENT(6);
713    version = ARGUMENT(5);
714    type = ARGUMENT(4);
715    name = ARGUMENT(3);
716    directory = ARGUMENT(2);
717    device = ARGUMENT(1);
718    host = ARGUMENT(0);
719
720    if (host != UNSPEC) {
721	CHECK_STRING(host);
722    }
723    if (device != UNSPEC) {
724	CHECK_STRING(device);
725    }
726
727    if (directory != UNSPEC) {
728	LispObj *dir;
729
730	CHECK_CONS(directory);
731	dir = CAR(directory);
732	CHECK_KEYWORD(dir);
733	if (dir != Kabsolute && dir != Krelative)
734	    LispDestroy("%s: directory type %s unknown",
735			STRFUN(builtin), STROBJ(dir));
736    }
737
738    if (name != UNSPEC) {
739	CHECK_STRING(name);
740    }
741    if (type != UNSPEC) {
742	CHECK_STRING(type);
743    }
744
745    if (version != UNSPEC && version != NIL) {
746	switch (OBJECT_TYPE(version)) {
747	    case LispFixnum_t:
748		if (FIXNUM_VALUE(version) >= 0)
749		    goto version_ok;
750	    case LispInteger_t:
751		if (INT_VALUE(version) >= 0)
752		    goto version_ok;
753		break;
754	    case LispDFloat_t:
755		if (DFLOAT_VALUE(version) >= 0.0)
756		    goto version_ok;
757		break;
758	    default:
759		break;
760	}
761	LispDestroy("%s: %s is not a positive real number",
762		    STRFUN(builtin), STROBJ(version));
763    }
764version_ok:
765
766    if (defaults != UNSPEC && !PATHNAMEP(defaults) &&
767	(host == UNSPEC || device == UNSPEC || directory == UNSPEC ||
768	 name == UNSPEC || type == UNSPEC || version == UNSPEC)) {
769	defaults = APPLY1(Oparse_namestring, defaults);
770	GC_PROTECT(defaults);
771    }
772
773    if (defaults != UNSPEC) {
774	defaults = defaults->data.pathname;
775	defaults = CDR(defaults);	/* host */
776	if (host == UNSPEC)
777	    host = CAR(defaults);
778	defaults = CDR(defaults);	/* device */
779	if (device == UNSPEC)
780	    device = CAR(defaults);
781	defaults = CDR(defaults);	/* directory */
782	if (directory == UNSPEC)
783	    directory = CAR(defaults);
784	defaults = CDR(defaults);	/* name */
785	if (name == UNSPEC)
786	    name = CAR(defaults);
787	defaults = CDR(defaults);	/* type */
788	if (type == UNSPEC)
789	    type = CAR(defaults);
790	defaults = CDR(defaults);	/* version */
791	if (version == UNSPEC)
792	    version = CAR(defaults);
793    }
794
795    /* string representation */
796    length = 0;
797    if (CONSP(directory)) {
798	if (CAR(directory) == Kabsolute)
799	    pathname[length++] = PATH_SEP;
800
801	for (cdr = CDR(directory); CONSP(cdr); cdr = CDR(cdr)) {
802	    CHECK_STRING(CAR(cdr));
803	    string = THESTR(CAR(cdr));
804	    alength = STRLEN(CAR(cdr));
805	    if (alength > NAME_MAX)
806		LispDestroy("%s: directory name too long %s",
807			    STRFUN(builtin), string);
808	    if (length + alength + 2 > sizeof(pathname))
809		alength = sizeof(pathname) - length - 2;
810	    memcpy(pathname + length, string, alength);
811	    length += alength;
812	    pathname[length++] = PATH_SEP;
813	}
814    }
815    if (STRINGP(name)) {
816	int xlength = 0;
817
818	if (STRINGP(type))
819	    xlength = STRLEN(type) + 1;
820
821	string = THESTR(name);
822	alength = STRLEN(name);
823	if (alength + xlength > NAME_MAX)
824	    LispDestroy("%s: file name too long %s",
825			STRFUN(builtin), string);
826	if (length + alength + 2 > sizeof(pathname))
827	    alength = sizeof(pathname) - length - 2;
828	memcpy(pathname + length, string, alength);
829	length += alength;
830    }
831    if (STRINGP(type)) {
832	if (length + 2 < sizeof(pathname))
833	    pathname[length++] = PATH_TYPESEP;
834	string = THESTR(type);
835	alength = STRLEN(type);
836	if (length + alength + 2 > sizeof(pathname))
837	    alength = sizeof(pathname) - length - 2;
838	memcpy(pathname + length, string, alength);
839	length += alength;
840    }
841    pathname[length] = '\0';
842    result = cons = CONS(LSTRING(pathname, length), NIL);
843    GC_PROTECT(result);
844
845    /* host */
846    RPLACD(cons, CONS(host == UNSPEC ? NIL : host, NIL));
847    cons = CDR(cons);
848
849    /* device */
850    RPLACD(cons, CONS(device == UNSPEC ? NIL : device, NIL));
851    cons = CDR(cons);
852
853    /* directory */
854    if (directory == UNSPEC)
855	cdr = CONS(Krelative, NIL);
856    else
857	cdr = directory;
858    RPLACD(cons, CONS(cdr, NIL));
859    cons = CDR(cons);
860
861    /* name */
862    RPLACD(cons, CONS(name == UNSPEC ? NIL : name, NIL));
863    cons = CDR(cons);
864
865    /* type */
866    RPLACD(cons, CONS(type == UNSPEC ? NIL : type, NIL));
867    cons = CDR(cons);
868
869    /* version */
870    RPLACD(cons, CONS(version == UNSPEC ? NIL : version, NIL));
871
872    GC_LEAVE();
873
874    return (PATHNAME(result));
875}
876
877LispObj *
878Lisp_PathnameHost(LispBuiltin *builtin)
879/*
880 pathname-host pathname
881 */
882{
883    return (LispPathnameField(PATH_HOST, 0));
884}
885
886LispObj *
887Lisp_PathnameDevice(LispBuiltin *builtin)
888/*
889 pathname-device pathname
890 */
891{
892    return (LispPathnameField(PATH_DEVICE, 0));
893}
894
895LispObj *
896Lisp_PathnameDirectory(LispBuiltin *builtin)
897/*
898 pathname-device pathname
899 */
900{
901    return (LispPathnameField(PATH_DIRECTORY, 0));
902}
903
904LispObj *
905Lisp_PathnameName(LispBuiltin *builtin)
906/*
907 pathname-name pathname
908 */
909{
910    return (LispPathnameField(PATH_NAME, 0));
911}
912
913LispObj *
914Lisp_PathnameType(LispBuiltin *builtin)
915/*
916 pathname-type pathname
917 */
918{
919    return (LispPathnameField(PATH_TYPE, 0));
920}
921
922LispObj *
923Lisp_PathnameVersion(LispBuiltin *builtin)
924/*
925 pathname-version pathname
926 */
927{
928    return (LispPathnameField(PATH_VERSION, 0));
929}
930
931LispObj *
932Lisp_FileNamestring(LispBuiltin *builtin)
933/*
934 file-namestring pathname
935 */
936{
937    return (LispPathnameField(PATH_NAME, 1));
938}
939
940LispObj *
941Lisp_DirectoryNamestring(LispBuiltin *builtin)
942/*
943 directory-namestring pathname
944 */
945{
946    return (LispPathnameField(PATH_DIRECTORY, 1));
947}
948
949LispObj *
950Lisp_EnoughNamestring(LispBuiltin *builtin)
951/*
952 enough-pathname pathname &optional defaults
953 */
954{
955    LispObj *pathname, *defaults;
956
957    defaults = ARGUMENT(1);
958    pathname = ARGUMENT(0);
959
960    if (defaults != UNSPEC && defaults != NIL) {
961	char *ppathname, *pdefaults, *pp, *pd;
962
963	if (!STRINGP(pathname)) {
964	    if (PATHNAMEP(pathname))
965		pathname  = CAR(pathname->data.pathname);
966	    else if (STREAMP(pathname) &&
967		     pathname->data.stream.type == LispStreamFile)
968		pathname  = CAR(pathname->data.stream.pathname->data.pathname);
969	    else
970		LispDestroy("%s: bad PATHNAME %s",
971			    STRFUN(builtin), STROBJ(pathname));
972	}
973
974	if (!STRINGP(defaults)) {
975	    if (PATHNAMEP(defaults))
976		defaults  = CAR(defaults->data.pathname);
977	    else if (STREAMP(defaults) &&
978		     defaults->data.stream.type == LispStreamFile)
979		defaults  = CAR(defaults->data.stream.pathname->data.pathname);
980	    else
981		LispDestroy("%s: bad DEFAULTS %s",
982			    STRFUN(builtin), STROBJ(defaults));
983	}
984
985	ppathname = pp = THESTR(pathname);
986	pdefaults = pd = THESTR(defaults);
987	while (*ppathname && *pdefaults && *ppathname == *pdefaults) {
988	    ppathname++;
989	    pdefaults++;
990	}
991	if (*pdefaults == '\0' && pdefaults > pd)
992	    --pdefaults;
993	if (*ppathname && *pdefaults && *pdefaults != PATH_SEP) {
994	    --ppathname;
995	    while (*ppathname != PATH_SEP && ppathname > pp)
996		--ppathname;
997	    if (*ppathname == PATH_SEP)
998		++ppathname;
999	}
1000
1001	return (STRING(ppathname));
1002    }
1003    else {
1004	if (STRINGP(pathname))
1005	    return (pathname);
1006	else if (PATHNAMEP(pathname))
1007	    return (CAR(pathname->data.pathname));
1008	else if (STREAMP(pathname)) {
1009	    if (pathname->data.stream.type == LispStreamFile)
1010		return (CAR(pathname->data.stream.pathname->data.pathname));
1011	}
1012    }
1013    LispDestroy("%s: bad PATHNAME %s", STRFUN(builtin), STROBJ(pathname));
1014
1015    return (NIL);
1016}
1017
1018LispObj *
1019Lisp_Namestring(LispBuiltin *builtin)
1020/*
1021 namestring pathname
1022 */
1023{
1024    return (LispPathnameField(PATH_STRING, 1));
1025}
1026
1027LispObj *
1028Lisp_HostNamestring(LispBuiltin *builtin)
1029/*
1030 host-namestring pathname
1031 */
1032{
1033    return (LispPathnameField(PATH_HOST, 1));
1034}
1035
1036LispObj *
1037Lisp_Pathnamep(LispBuiltin *builtin)
1038/*
1039 pathnamep object
1040 */
1041{
1042    LispObj *object;
1043
1044    object = ARGUMENT(0);
1045
1046    return (PATHNAMEP(object) ? T : NIL);
1047}
1048
1049/* XXX only checks if host is a string and only checks the HOME enviroment
1050 * variable */
1051LispObj *
1052Lisp_UserHomedirPathname(LispBuiltin *builtin)
1053/*
1054 user-homedir-pathname &optional host
1055 */
1056{
1057    GC_ENTER();
1058    int length;
1059    char *home = getenv("HOME"), data[PATH_MAX + 1];
1060    LispObj *result;
1061
1062    LispObj *host;
1063
1064    host = ARGUMENT(0);
1065
1066    if (host != UNSPEC && !STRINGP(host))
1067	LispDestroy("%s: bad hostname %s", STRFUN(builtin), STROBJ(host));
1068
1069    length = 0;
1070    if (home) {
1071	length = strlen(home);
1072	strncpy(data, home, length);
1073	if (length && home[length - 1] != PATH_SEP)
1074	    data[length++] = PATH_SEP;
1075    }
1076    data[length] = '\0';
1077
1078    result = LSTRING(data, length);
1079    GC_PROTECT(result);
1080    result = APPLY1(Oparse_namestring, result);
1081    GC_LEAVE();
1082
1083    return (result);
1084}
1085
1086LispObj *
1087Lisp_Truename(LispBuiltin *builtin)
1088{
1089    return (LispProbeFile(builtin, 0));
1090}
1091
1092LispObj *
1093Lisp_ProbeFile(LispBuiltin *builtin)
1094{
1095    return (LispProbeFile(builtin, 1));
1096}
1097