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 Csar 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 */ 46 LispObj *Oparse_namestring, *Kerror, *Kabsolute, *Krelative, *Kskip; 47 48 /* 49 * Implementation 50 */ 51 void 52 LispPathnameInit(void) 53 { 54 Kerror = KEYWORD("ERROR"); 55 Oparse_namestring = STATIC_ATOM("PARSE-NAMESTRING"); 56 Kabsolute = KEYWORD("ABSOLUTE"); 57 Krelative = KEYWORD("RELATIVE"); 58 } 59 60 static int 61 glob_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 */ 162 LispObj * 163 Lisp_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 439 LispObj * 440 Lisp_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 700 LispObj * 701 Lisp_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 } 765 version_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 878 LispObj * 879 Lisp_PathnameHost(LispBuiltin *builtin) 880 /* 881 pathname-host pathname 882 */ 883 { 884 return (LispPathnameField(PATH_HOST, 0)); 885 } 886 887 LispObj * 888 Lisp_PathnameDevice(LispBuiltin *builtin) 889 /* 890 pathname-device pathname 891 */ 892 { 893 return (LispPathnameField(PATH_DEVICE, 0)); 894 } 895 896 LispObj * 897 Lisp_PathnameDirectory(LispBuiltin *builtin) 898 /* 899 pathname-device pathname 900 */ 901 { 902 return (LispPathnameField(PATH_DIRECTORY, 0)); 903 } 904 905 LispObj * 906 Lisp_PathnameName(LispBuiltin *builtin) 907 /* 908 pathname-name pathname 909 */ 910 { 911 return (LispPathnameField(PATH_NAME, 0)); 912 } 913 914 LispObj * 915 Lisp_PathnameType(LispBuiltin *builtin) 916 /* 917 pathname-type pathname 918 */ 919 { 920 return (LispPathnameField(PATH_TYPE, 0)); 921 } 922 923 LispObj * 924 Lisp_PathnameVersion(LispBuiltin *builtin) 925 /* 926 pathname-version pathname 927 */ 928 { 929 return (LispPathnameField(PATH_VERSION, 0)); 930 } 931 932 LispObj * 933 Lisp_FileNamestring(LispBuiltin *builtin) 934 /* 935 file-namestring pathname 936 */ 937 { 938 return (LispPathnameField(PATH_NAME, 1)); 939 } 940 941 LispObj * 942 Lisp_DirectoryNamestring(LispBuiltin *builtin) 943 /* 944 directory-namestring pathname 945 */ 946 { 947 return (LispPathnameField(PATH_DIRECTORY, 1)); 948 } 949 950 LispObj * 951 Lisp_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 1019 LispObj * 1020 Lisp_Namestring(LispBuiltin *builtin) 1021 /* 1022 namestring pathname 1023 */ 1024 { 1025 return (LispPathnameField(PATH_STRING, 1)); 1026 } 1027 1028 LispObj * 1029 Lisp_HostNamestring(LispBuiltin *builtin) 1030 /* 1031 host-namestring pathname 1032 */ 1033 { 1034 return (LispPathnameField(PATH_HOST, 1)); 1035 } 1036 1037 LispObj * 1038 Lisp_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 */ 1052 LispObj * 1053 Lisp_UserHomedirPathname(LispBuiltin *builtin) 1054 /* 1055 user-homedir-pathname &optional host 1056 */ 1057 { 1058 GC_ENTER(); 1059 char *home = getenv("HOME"), data[PATH_MAX + 1]; 1060 char sepstr[] = {PATH_SEP, '\0'}; 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 if (home) { 1071 strlcpy(data, home, sizeof(data)); 1072 if (data[0] != '\0' && data[strlen(data) - 1] != PATH_SEP) 1073 strlcat(data, sepstr, sizeof(data)); 1074 } else { 1075 data[0] = '\0'; 1076 } 1077 1078 result = STRING(data); 1079 GC_PROTECT(result); 1080 result = APPLY1(Oparse_namestring, result); 1081 GC_LEAVE(); 1082 1083 return (result); 1084 } 1085 1086 LispObj * 1087 Lisp_Truename(LispBuiltin *builtin) 1088 { 1089 return (LispProbeFile(builtin, 0)); 1090 } 1091 1092 LispObj * 1093 Lisp_ProbeFile(LispBuiltin *builtin) 1094 { 1095 return (LispProbeFile(builtin, 1)); 1096 } 1097
Indexes created Wed Jul 01 00:25:26 UTC 2026