pathname.c revision f765521f 
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], *send;
488	const char *namestr, *typestr;
489	long start, end, length, alength, namelen, typelen;
490
491	LispCheckSequenceStartEnd(builtin, object, ostart, oend,
492				  &start, &end, &length);
493	alength = end - start;
494
495	if (alength > sizeof(data) - 1)
496	    LispDestroy("%s: string %s too large",
497			STRFUN(builtin), STROBJ(object));
498	memcpy(data, name + start, alength);
499#ifndef KEEP_EXTRA_PATH_SEP
500	ptr = data;
501	send = ptr + alength;
502	while (ptr < send) {
503	    if (*ptr++ == PATH_SEP) {
504		for (str = ptr; str < send && *str == PATH_SEP; str++)
505		    ;
506		if (str - ptr) {
507		    memmove(ptr, str, alength - (str - data));
508		    alength -= str - ptr;
509		    send -= str - ptr;
510		}
511	    }
512	}
513#endif
514	data[alength] = '\0';
515	memcpy(string, data, alength + 1);
516
517	if (PATHNAMEP(defaults))
518	    defaults = defaults->data.pathname;
519
520	/* string name */
521	result = cons = CONS(NIL, NIL);
522	GC_PROTECT(result);
523
524	/* host */
525	if (defaults != NIL)
526	    defaults = CDR(defaults);
527	cdr = defaults == NIL ? NIL : CAR(defaults);
528	RPLACD(cons, CONS(cdr, NIL));
529	cons = CDR(cons);
530
531	/* device */
532	if (defaults != NIL)
533	    defaults = CDR(defaults);
534	cdr = defaults == NIL ? NIL : CAR(defaults);
535	RPLACD(cons, CONS(cdr, NIL));
536	cons = CDR(cons);
537
538	/* directory */
539	if (defaults != NIL)
540	    defaults = CDR(defaults);
541	if (*data == PATH_SEP)
542	    cdr = CONS(Kabsolute, NIL);
543	else
544	    cdr = CONS(Krelative, NIL);
545	RPLACD(cons, CONS(cdr, NIL));
546	cons = CDR(cons);
547	/* directory components */
548	ptr = data;
549	send = data + alength;
550	if (*ptr == PATH_SEP)
551	    ++ptr;
552	for (str = ptr; str < send; str++) {
553	    if (*str == PATH_SEP)
554		break;
555	}
556	while (str < send) {
557	    *str++ = '\0';
558	    if (str - ptr > NAME_MAX)
559		LispDestroy("%s: directory name too long %s",
560			    STRFUN(builtin), ptr);
561	    RPLACD(cdr, CONS(LSTRING(ptr, str - ptr - 1), NIL));
562	    cdr = CDR(cdr);
563	    for (ptr = str; str < send; str++) {
564		if (*str == PATH_SEP)
565		    break;
566	    }
567	}
568	if (str - ptr > NAME_MAX)
569	    LispDestroy("%s: file name too long %s", STRFUN(builtin), ptr);
570	if (CAAR(cons) == Krelative &&
571	    defaults != NIL && CAAR(defaults) == Kabsolute) {
572	    /* defaults specify directory and pathname doesn't */
573	    char *tstring;
574	    long dlength, tlength;
575	    LispObj *dir = CDAR(defaults);
576
577	    for (dlength = 1; CONSP(dir); dir = CDR(dir))
578		dlength += STRLEN(CAR(dir)) + 1;
579	    if (alength + dlength < PATH_MAX) {
580		memmove(data + dlength, data, alength + 1);
581		memmove(string + dlength, string, alength + 1);
582		alength += dlength;
583		ptr += dlength;
584		send += dlength;
585		CAAR(cons) = Kabsolute;
586		for (dir = CDAR(defaults), cdr = CAR(cons);
587		     CONSP(dir);
588		     dir = CDR(dir)) {
589		    RPLACD(cdr, CONS(CAR(dir), CDR(cdr)));
590		    cdr = CDR(cdr);
591		}
592		dir = CDAR(defaults);
593		data[0] = string[0] = PATH_SEP;
594		for (dlength = 1; CONSP(dir); dir = CDR(dir)) {
595		    tstring = THESTR(CAR(dir));
596		    tlength = STRLEN(CAR(dir));
597		    memcpy(data + dlength, tstring, tlength);
598		    memcpy(string + dlength, tstring, tlength);
599		    dlength += tlength;
600		    data[dlength] = string[dlength] = PATH_SEP;
601		    ++dlength;
602		}
603	    }
604	}
605
606	/* name */
607	if (defaults != NIL)
608	    defaults = CDR(defaults);
609	cdr = defaults == NIL ? NIL : CAR(defaults);
610	for (typelen = 0, str = ptr; str < send; str++) {
611	    if (*str == PATH_TYPESEP) {
612		typelen = 1;
613		break;
614	    }
615	}
616	if (*ptr)
617	    cdr = LSTRING(ptr, str - ptr);
618	if (STRINGP(cdr)) {
619	    namestr = THESTR(cdr);
620	    namelen = STRLEN(cdr);
621	}
622	else {
623	    namestr = "";
624	    namelen = 0;
625	}
626	RPLACD(cons, CONS(cdr, NIL));
627	cons = CDR(cons);
628
629	/* type */
630	if (defaults != NIL)
631	    defaults = CDR(defaults);
632	cdr = defaults == NIL ? NIL : CAR(defaults);
633	ptr = str + typelen;
634	if (*ptr)
635	    cdr = LSTRING(ptr, send - ptr);
636	if (STRINGP(cdr)) {
637	    typestr = THESTR(cdr);
638	    typelen = STRLEN(cdr);
639	}
640	else {
641	    typestr = "";
642	    typelen = 0;
643	}
644	RPLACD(cons, CONS(cdr, NIL));
645	cons = CDR(cons);
646
647	/* version */
648	if (defaults != NIL)
649	    defaults = CDR(defaults);
650	cdr = defaults == NIL ? NIL : CAR(defaults);
651	RPLACD(cons, CONS(cdr, NIL));
652
653	/* string representation, must be done here to use defaults */
654	for (ptr = string + alength; ptr >= string; ptr--) {
655	    if (*ptr == PATH_SEP)
656		break;
657	}
658	if (ptr >= string)
659	    ++ptr;
660	else
661	    ptr = string;
662	*ptr = '\0';
663
664	length = ptr - string;
665
666	alength = namelen;
667	if (alength) {
668	    if (length + alength + 2 > sizeof(string))
669		alength = sizeof(string) - length - 2;
670	    memcpy(string + length, namestr, alength);
671	    length += alength;
672	}
673
674	alength = typelen;
675	if (alength) {
676	    if (length + 2 < sizeof(string))
677		string[length++] = PATH_TYPESEP;
678	    if (length + alength + 2 > sizeof(string))
679		alength = sizeof(string) - length - 2;
680	    memcpy(string + length, typestr, alength);
681	    length += alength;
682	}
683	string[length] = '\0';
684
685	RPLACA(result,  LSTRING(string, length));
686	RETURN(0) = FIXNUM(end);
687
688	result = PATHNAME(result);
689    }
690    else if (junk_allowed == UNSPEC || junk_allowed == NIL)
691	LispDestroy("%s: bad argument %s", STRFUN(builtin), STROBJ(object));
692    else
693	RETURN(0) = NIL;
694
695    GC_LEAVE();
696
697    return (result);
698}
699
700LispObj *
701Lisp_MakePathname(LispBuiltin *builtin)
702/*
703 make-pathname &key host device directory name type version defaults
704 */
705{
706    GC_ENTER();
707    int length, alength;
708    char *string, pathname[PATH_MAX + 1];
709    LispObj *result, *cdr, *cons;
710
711    LispObj *host, *device, *directory, *name, *type, *version, *defaults;
712
713    defaults = ARGUMENT(6);
714    version = ARGUMENT(5);
715    type = ARGUMENT(4);
716    name = ARGUMENT(3);
717    directory = ARGUMENT(2);
718    device = ARGUMENT(1);
719    host = ARGUMENT(0);
720
721    if (host != UNSPEC) {
722	CHECK_STRING(host);
723    }
724    if (device != UNSPEC) {
725	CHECK_STRING(device);
726    }
727
728    if (directory != UNSPEC) {
729	LispObj *dir;
730
731	CHECK_CONS(directory);
732	dir = CAR(directory);
733	CHECK_KEYWORD(dir);
734	if (dir != Kabsolute && dir != Krelative)
735	    LispDestroy("%s: directory type %s unknown",
736			STRFUN(builtin), STROBJ(dir));
737    }
738
739    if (name != UNSPEC) {
740	CHECK_STRING(name);
741    }
742    if (type != UNSPEC) {
743	CHECK_STRING(type);
744    }
745
746    if (version != UNSPEC && version != NIL) {
747	switch (OBJECT_TYPE(version)) {
748	    case LispFixnum_t:
749		if (FIXNUM_VALUE(version) >= 0)
750		    goto version_ok;
751	    case LispInteger_t:
752		if (INT_VALUE(version) >= 0)
753		    goto version_ok;
754		break;
755	    case LispDFloat_t:
756		if (DFLOAT_VALUE(version) >= 0.0)
757		    goto version_ok;
758		break;
759	    default:
760		break;
761	}
762	LispDestroy("%s: %s is not a positive real number",
763		    STRFUN(builtin), STROBJ(version));
764    }
765version_ok:
766
767    if (defaults != UNSPEC && !PATHNAMEP(defaults) &&
768	(host == UNSPEC || device == UNSPEC || directory == UNSPEC ||
769	 name == UNSPEC || type == UNSPEC || version == UNSPEC)) {
770	defaults = APPLY1(Oparse_namestring, defaults);
771	GC_PROTECT(defaults);
772    }
773
774    if (defaults != UNSPEC) {
775	defaults = defaults->data.pathname;
776	defaults = CDR(defaults);	/* host */
777	if (host == UNSPEC)
778	    host = CAR(defaults);
779	defaults = CDR(defaults);	/* device */
780	if (device == UNSPEC)
781	    device = CAR(defaults);
782	defaults = CDR(defaults);	/* directory */
783	if (directory == UNSPEC)
784	    directory = CAR(defaults);
785	defaults = CDR(defaults);	/* name */
786	if (name == UNSPEC)
787	    name = CAR(defaults);
788	defaults = CDR(defaults);	/* type */
789	if (type == UNSPEC)
790	    type = CAR(defaults);
791	defaults = CDR(defaults);	/* version */
792	if (version == UNSPEC)
793	    version = CAR(defaults);
794    }
795
796    /* string representation */
797    length = 0;
798    if (CONSP(directory)) {
799	if (CAR(directory) == Kabsolute)
800	    pathname[length++] = PATH_SEP;
801
802	for (cdr = CDR(directory); CONSP(cdr); cdr = CDR(cdr)) {
803	    CHECK_STRING(CAR(cdr));
804	    string = THESTR(CAR(cdr));
805	    alength = STRLEN(CAR(cdr));
806	    if (alength > NAME_MAX)
807		LispDestroy("%s: directory name too long %s",
808			    STRFUN(builtin), string);
809	    if (length + alength + 2 > sizeof(pathname))
810		alength = sizeof(pathname) - length - 2;
811	    memcpy(pathname + length, string, alength);
812	    length += alength;
813	    pathname[length++] = PATH_SEP;
814	}
815    }
816    if (STRINGP(name)) {
817	int xlength = 0;
818
819	if (STRINGP(type))
820	    xlength = STRLEN(type) + 1;
821
822	string = THESTR(name);
823	alength = STRLEN(name);
824	if (alength + xlength > NAME_MAX)
825	    LispDestroy("%s: file name too long %s",
826			STRFUN(builtin), string);
827	if (length + alength + 2 > sizeof(pathname))
828	    alength = sizeof(pathname) - length - 2;
829	memcpy(pathname + length, string, alength);
830	length += alength;
831    }
832    if (STRINGP(type)) {
833	if (length + 2 < sizeof(pathname))
834	    pathname[length++] = PATH_TYPESEP;
835	string = THESTR(type);
836	alength = STRLEN(type);
837	if (length + alength + 2 > sizeof(pathname))
838	    alength = sizeof(pathname) - length - 2;
839	memcpy(pathname + length, string, alength);
840	length += alength;
841    }
842    pathname[length] = '\0';
843    result = cons = CONS(LSTRING(pathname, length), NIL);
844    GC_PROTECT(result);
845
846    /* host */
847    RPLACD(cons, CONS(host == UNSPEC ? NIL : host, NIL));
848    cons = CDR(cons);
849
850    /* device */
851    RPLACD(cons, CONS(device == UNSPEC ? NIL : device, NIL));
852    cons = CDR(cons);
853
854    /* directory */
855    if (directory == UNSPEC)
856	cdr = CONS(Krelative, NIL);
857    else
858	cdr = directory;
859    RPLACD(cons, CONS(cdr, NIL));
860    cons = CDR(cons);
861
862    /* name */
863    RPLACD(cons, CONS(name == UNSPEC ? NIL : name, NIL));
864    cons = CDR(cons);
865
866    /* type */
867    RPLACD(cons, CONS(type == UNSPEC ? NIL : type, NIL));
868    cons = CDR(cons);
869
870    /* version */
871    RPLACD(cons, CONS(version == UNSPEC ? NIL : version, NIL));
872
873    GC_LEAVE();
874
875    return (PATHNAME(result));
876}
877
878LispObj *
879Lisp_PathnameHost(LispBuiltin *builtin)
880/*
881 pathname-host pathname
882 */
883{
884    return (LispPathnameField(PATH_HOST, 0));
885}
886
887LispObj *
888Lisp_PathnameDevice(LispBuiltin *builtin)
889/*
890 pathname-device pathname
891 */
892{
893    return (LispPathnameField(PATH_DEVICE, 0));
894}
895
896LispObj *
897Lisp_PathnameDirectory(LispBuiltin *builtin)
898/*
899 pathname-device pathname
900 */
901{
902    return (LispPathnameField(PATH_DIRECTORY, 0));
903}
904
905LispObj *
906Lisp_PathnameName(LispBuiltin *builtin)
907/*
908 pathname-name pathname
909 */
910{
911    return (LispPathnameField(PATH_NAME, 0));
912}
913
914LispObj *
915Lisp_PathnameType(LispBuiltin *builtin)
916/*
917 pathname-type pathname
918 */
919{
920    return (LispPathnameField(PATH_TYPE, 0));
921}
922
923LispObj *
924Lisp_PathnameVersion(LispBuiltin *builtin)
925/*
926 pathname-version pathname
927 */
928{
929    return (LispPathnameField(PATH_VERSION, 0));
930}
931
932LispObj *
933Lisp_FileNamestring(LispBuiltin *builtin)
934/*
935 file-namestring pathname
936 */
937{
938    return (LispPathnameField(PATH_NAME, 1));
939}
940
941LispObj *
942Lisp_DirectoryNamestring(LispBuiltin *builtin)
943/*
944 directory-namestring pathname
945 */
946{
947    return (LispPathnameField(PATH_DIRECTORY, 1));
948}
949
950LispObj *
951Lisp_EnoughNamestring(LispBuiltin *builtin)
952/*
953 enough-pathname pathname &optional defaults
954 */
955{
956    LispObj *pathname, *defaults;
957
958    defaults = ARGUMENT(1);
959    pathname = ARGUMENT(0);
960
961    if (defaults != UNSPEC && defaults != NIL) {
962	char *ppathname, *pdefaults, *pp, *pd;
963
964	if (!STRINGP(pathname)) {
965	    if (PATHNAMEP(pathname))
966		pathname  = CAR(pathname->data.pathname);
967	    else if (STREAMP(pathname) &&
968		     pathname->data.stream.type == LispStreamFile)
969		pathname  = CAR(pathname->data.stream.pathname->data.pathname);
970	    else
971		LispDestroy("%s: bad PATHNAME %s",
972			    STRFUN(builtin), STROBJ(pathname));
973	}
974
975	if (!STRINGP(defaults)) {
976	    if (PATHNAMEP(defaults))
977		defaults  = CAR(defaults->data.pathname);
978	    else if (STREAMP(defaults) &&
979		     defaults->data.stream.type == LispStreamFile)
980		defaults  = CAR(defaults->data.stream.pathname->data.pathname);
981	    else
982		LispDestroy("%s: bad DEFAULTS %s",
983			    STRFUN(builtin), STROBJ(defaults));
984	}
985
986	ppathname = pp = THESTR(pathname);
987	pdefaults = pd = THESTR(defaults);
988	while (*ppathname && *pdefaults && *ppathname == *pdefaults) {
989	    ppathname++;
990	    pdefaults++;
991	}
992	if (*pdefaults == '\0' && pdefaults > pd)
993	    --pdefaults;
994	if (*ppathname && *pdefaults && *pdefaults != PATH_SEP) {
995	    --ppathname;
996	    while (*ppathname != PATH_SEP && ppathname > pp)
997		--ppathname;
998	    if (*ppathname == PATH_SEP)
999		++ppathname;
1000	}
1001
1002	return (STRING(ppathname));
1003    }
1004    else {
1005	if (STRINGP(pathname))
1006	    return (pathname);
1007	else if (PATHNAMEP(pathname))
1008	    return (CAR(pathname->data.pathname));
1009	else if (STREAMP(pathname)) {
1010	    if (pathname->data.stream.type == LispStreamFile)
1011		return (CAR(pathname->data.stream.pathname->data.pathname));
1012	}
1013    }
1014    LispDestroy("%s: bad PATHNAME %s", STRFUN(builtin), STROBJ(pathname));
1015
1016    return (NIL);
1017}
1018
1019LispObj *
1020Lisp_Namestring(LispBuiltin *builtin)
1021/*
1022 namestring pathname
1023 */
1024{
1025    return (LispPathnameField(PATH_STRING, 1));
1026}
1027
1028LispObj *
1029Lisp_HostNamestring(LispBuiltin *builtin)
1030/*
1031 host-namestring pathname
1032 */
1033{
1034    return (LispPathnameField(PATH_HOST, 1));
1035}
1036
1037LispObj *
1038Lisp_Pathnamep(LispBuiltin *builtin)
1039/*
1040 pathnamep object
1041 */
1042{
1043    LispObj *object;
1044
1045    object = ARGUMENT(0);
1046
1047    return (PATHNAMEP(object) ? T : NIL);
1048}
1049
1050/* XXX only checks if host is a string and only checks the HOME enviroment
1051 * variable */
1052LispObj *
1053Lisp_UserHomedirPathname(LispBuiltin *builtin)
1054/*
1055 user-homedir-pathname &optional host
1056 */
1057{
1058    GC_ENTER();
1059    int length;
1060    char *home = getenv("HOME"), data[PATH_MAX + 1];
1061    LispObj *result;
1062
1063    LispObj *host;
1064
1065    host = ARGUMENT(0);
1066
1067    if (host != UNSPEC && !STRINGP(host))
1068	LispDestroy("%s: bad hostname %s", STRFUN(builtin), STROBJ(host));
1069
1070    length = 0;
1071    if (home) {
1072	length = strlen(home);
1073	strncpy(data, home, length);
1074	if (length && home[length - 1] != PATH_SEP)
1075	    data[length++] = PATH_SEP;
1076    }
1077    data[length] = '\0';
1078
1079    result = LSTRING(data, length);
1080    GC_PROTECT(result);
1081    result = APPLY1(Oparse_namestring, result);
1082    GC_LEAVE();
1083
1084    return (result);
1085}
1086
1087LispObj *
1088Lisp_Truename(LispBuiltin *builtin)
1089{
1090    return (LispProbeFile(builtin, 0));
1091}
1092
1093LispObj *
1094Lisp_ProbeFile(LispBuiltin *builtin)
1095{
1096    return (LispProbeFile(builtin, 1));
1097}
1098