1 /* $Id$
2
3 Part of SWI-Prolog
4
5 Author: Jan Wielemaker
6 E-mail: wielemak@science.uva.nl
7 WWW: http://www.swi-prolog.org
8 Copyright (C): 1985-2007, University of Amsterdam
9
10 This library is free software; you can redistribute it and/or
11 modify it under the terms of the GNU Lesser General Public
12 License as published by the Free Software Foundation; either
13 version 2.1 of the License, or (at your option) any later version.
14
15 This library is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 Lesser General Public License for more details.
19
20 You should have received a copy of the GNU Lesser General Public
21 License along with this library; if not, write to the Free Software
22 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23 */
24
25 /* Modified (M) 1993 Dave Sherratt */
26
27 /*#define O_DEBUG 1*/
28
29 #if OS2 && EMX
30 #include <os2.h> /* this has to appear before pl-incl.h */
31 #endif
32
33 #include "pl-incl.h"
34 #include "pl-ctype.h"
35 #include "pl-utf8.h"
36 #undef abs
37 #include <math.h> /* avoid abs() problem with msvc++ */
38 #include <stdio.h> /* rename() and remove() prototypes */
39
40 #if HAVE_SYS_STAT_H
41 #include <sys/stat.h>
42 #endif
43 #if !O_XOS
44 #define statfunc stat
45 #endif
46 #if HAVE_PWD_H
47 #include <pwd.h>
48 #endif
49 #if HAVE_VFORK_H
50 #include <vfork.h>
51 #endif
52 #ifdef HAVE_UNISTD_H
53 #include <unistd.h>
54 #endif
55 #ifdef HAVE_SYS_FILE_H
56 #include <sys/file.h>
57 #endif
58 #if defined(HAVE_SYS_RESOURCE_H)
59 #include <sys/resource.h>
60 #endif
61 #ifdef HAVE_FTIME
62 #include <sys/timeb.h>
63 #endif
64 #include <time.h>
65 #include <fcntl.h>
66 #ifndef __WATCOMC__ /* appears a conflict */
67 #include <errno.h>
68 #endif
69
70 #if defined(__WATCOMC__)
71 #include <io.h>
72 #include <dos.h>
73 #endif
74
75 #if OS2 && EMX
76 static double initial_time;
77 #endif /* OS2 */
78
79 #define LOCK() PL_LOCK(L_OS)
80 #define UNLOCK() PL_UNLOCK(L_OS)
81
82 static void initExpand(void);
83 static void cleanupExpand(void);
84 static void initEnviron(void);
85 static char * Which(const char *program, char *fullname);
86
87 #ifndef DEFAULT_PATH
88 #define DEFAULT_PATH "/bin:/usr/bin"
89 #endif
90
91 /*******************************
92 * GLOBALS *
93 *******************************/
94 #ifdef HAVE_CLOCK
95 long clock_wait_ticks;
96 #endif
97
98 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
99 This module is a contraction of functions that used to be all over the
100 place. together with pl-os.h (included by pl-incl.h) this file
101 should define a basic layer around the OS, on which the rest of
102 SWI-Prolog is based. SWI-Prolog has been developed on SUN, running
103 SunOs 3.4 and later 4.0.
104
105 Unfortunately some OS's simply do not offer an equivalent to SUN os
106 features. In most cases part of the functionality of the system will
107 have to be dropped. See the header of pl-incl.h for details.
108 - - - - - - - - - - - - - - - - */
109
110 /********************************
111 * INITIALISATION *
112 *********************************/
113
114 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
115 bool initOs()
116
117 Initialise the OS dependant functions.
118 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
119
120 bool
initOs(void)121 initOs(void)
122 { GET_LD
123 DEBUG(1, Sdprintf("OS:initExpand() ...\n"));
124 initExpand();
125 DEBUG(1, Sdprintf("OS:initEnviron() ...\n"));
126 initEnviron();
127
128 #ifdef __WINDOWS__
129 setPrologFlagMask(PLFLAG_FILE_CASE_PRESERVING);
130 #else
131 setPrologFlagMask(PLFLAG_FILE_CASE);
132 setPrologFlagMask(PLFLAG_FILE_CASE_PRESERVING);
133 #endif
134
135 #ifdef HAVE_CLOCK
136 clock_wait_ticks = 0L;
137 #endif
138
139 #if OS2
140 { DATETIME i;
141 DosGetDateTime((PDATETIME)&i);
142 initial_time = (i.hours * 3600.0)
143 + (i.minutes * 60.0)
144 + i.seconds
145 + (i.hundredths / 100.0);
146 }
147 #endif /* OS2 */
148
149 DEBUG(1, Sdprintf("OS:done\n"));
150
151 succeed;
152 }
153
154
155 void
cleanupOs(void)156 cleanupOs(void)
157 { cleanupExpand();
158 }
159
160
161 /********************************
162 * OS ERRORS *
163 *********************************/
164
165 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
166 char *OsError()
167 Return a char *, holding a description of the last OS call error.
168 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
169
170 char *
OsError(void)171 OsError(void)
172 {
173 #ifdef HAVE_STRERROR
174 #ifdef __WINDOWS__
175 return strerror(_xos_errno());
176 #else
177 return strerror(errno);
178 #endif
179 #else /*HAVE_STRERROR*/
180 static char errmsg[64];
181
182 #ifdef __unix__
183 extern int sys_nerr;
184 #if !EMX
185 extern char *sys_errlist[];
186 #endif
187 extern int errno;
188
189 if ( errno < sys_nerr )
190 return sys_errlist[errno];
191 #endif
192
193 Ssprintf(errmsg, "Unknown Error (%d)", errno);
194 return errmsg;
195 #endif /*HAVE_STRERROR*/
196 }
197
198 /********************************
199 * PROCESS CHARACTERISTICS *
200 *********************************/
201
202 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
203 double CpuTime(cputime_kind)
204
205 Returns a floating point number, representing the amount of (user)
206 CPU-seconds used by the process Prolog is in. For systems that do
207 not allow you to obtain this information you may wish to return
208 elapsed time since Prolog was started, as this function is used to
209 by consult/1 and time/1 to determine the amount of CPU time used to
210 consult a file or to execute a query.
211 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
212
213 #ifndef __WINDOWS__ /* defined in pl-nt.c */
214
215 #ifdef HAVE_TIMES
216 #include <sys/times.h>
217
218 #if defined(_SC_CLK_TCK)
219 #define Hz ((int)sysconf(_SC_CLK_TCK))
220 #else
221 #ifdef HZ
222 # define Hz HZ
223 #else
224 # define Hz 60 /* if nothing better: guess */
225 #endif
226 #endif /*_SC_CLK_TCK*/
227 #endif /*HAVE_TIMES*/
228
229
230 double
CpuTime(cputime_kind which)231 CpuTime(cputime_kind which)
232 {
233 #ifdef HAVE_TIMES
234 struct tms t;
235 double used;
236 static int MTOK_got_hz = FALSE;
237 static double MTOK_hz;
238
239 if ( !MTOK_got_hz )
240 { MTOK_hz = (double) Hz;
241 MTOK_got_hz++;
242 }
243 times(&t);
244
245 switch( which )
246 { case CPU_USER:
247 used = (double) t.tms_utime / MTOK_hz;
248 break;
249 case CPU_SYSTEM:
250 default: /* make compiler happy */
251 used = (double) t.tms_stime / MTOK_hz;
252 }
253
254 if ( isnan(used) ) /* very dubious, but this */
255 used = 0.0; /* happens when running under GDB */
256
257 return used;
258 #else
259
260 #if OS2 && EMX
261 DATETIME i;
262
263 DosGetDateTime((PDATETIME)&i);
264 return (((i.hours * 3600)
265 + (i.minutes * 60)
266 + i.seconds
267 + (i.hundredths / 100.0)) - initial_time);
268 #else
269
270 #ifdef HAVE_CLOCK
271 return (double) (clock() - clock_wait_ticks) / (double) CLOCKS_PER_SEC;
272 #else
273
274 return 0.0;
275
276 #endif
277 #endif
278 #endif
279 }
280
281 #endif /*__WINDOWS__*/
282
283 void
PL_clock_wait_ticks(long waited)284 PL_clock_wait_ticks(long waited)
285 {
286 #ifdef HAVE_CLOCK
287 clock_wait_ticks += waited;
288 #endif
289 }
290
291
292 double
WallTime(void)293 WallTime(void)
294 { double stime;
295
296 #if HAVE_CLOCK_GETTIME
297 struct timespec tp;
298
299 clock_gettime(CLOCK_REALTIME, &tp);
300 stime = (double)tp.tv_sec + (double)tp.tv_nsec/1000000000.0;
301 #else
302 #ifdef HAVE_GETTIMEOFDAY
303 struct timeval tp;
304
305 gettimeofday(&tp, NULL);
306 stime = (double)tp.tv_sec + (double)tp.tv_usec/1000000.0;
307 #else
308 #ifdef HAVE_FTIME
309 struct timeb tb;
310
311 ftime(&tb);
312 stime = (double)tb.time + (double)tb.millitm/1000.0;
313 #else
314 stime = (double)time((time_t *)NULL);
315 #endif
316 #endif
317 #endif
318
319 return stime;
320 }
321
322 /*******************************
323 * FEATURES *
324 *******************************/
325
326 #ifndef __WINDOWS__ /* Windows version in pl-nt.c */
327
328 #ifdef HAVE_SC_NPROCESSORS_CONF
329 static int
CpuCount()330 CpuCount()
331 {
332 return sysconf(_SC_NPROCESSORS_CONF);
333 }
334 #else
335
336 #ifdef PROCFS_CPUINFO
337 static int
CpuCount()338 CpuCount()
339 { FILE *fd = fopen("/proc/cpuinfo", "r");
340
341 if ( fd )
342 { char buf[256];
343 int count = 0;
344
345 while(fgets(buf, sizeof(buf)-1, fd))
346 { char *vp;
347
348 if ( (vp = strchr(buf, ':')) )
349 { char *en;
350
351 for(en=vp; en > buf && en[-1] <= ' '; en--)
352 ;
353 *en = EOS;
354 DEBUG(2, Sdprintf("Got %s = %s\n", buf, vp+2));
355 if ( streq("processor", buf) && isDigit(vp[2]) )
356 { int cpu = atoi(vp+2);
357
358 if ( cpu+1 > count )
359 count = cpu+1;
360 }
361 }
362 }
363
364 fclose(fd);
365 return count;
366 }
367
368 return 0;
369 }
370
371 #else /*PROCFS_CPUINFO*/
372
373 #ifdef HAVE_SYSCTLBYNAME /* MacOS X */
374
375 #include <sys/param.h>
376 #include <sys/sysctl.h>
377
378 int
CpuCount()379 CpuCount()
380 { int count ;
381 size_t size=sizeof(count) ;
382
383 if ( sysctlbyname("hw.ncpu", &count, &size, NULL, 0) )
384 return 0;
385
386 return count;
387 }
388
389 #else
390
391 #define CpuCount() 0
392
393 #endif /*sysctlbyname*/
394
395 #endif /*PROCFS_CPUINFO*/
396
397 #endif /*HAVE_SC_NPROCESSORS_CONF*/
398
399
400 void
setOSPrologFlags(void)401 setOSPrologFlags(void)
402 { int cpu_count = CpuCount();
403
404 if ( cpu_count > 0 )
405 PL_set_prolog_flag("cpu_count", PL_INTEGER|FF_READONLY, cpu_count);
406 }
407 #endif
408
409 /*******************************
410 * MEMORY *
411 *******************************/
412
413 uintptr_t
UsedMemory(void)414 UsedMemory(void)
415 { GET_LD
416
417 #if defined(HAVE_GETRUSAGE) && defined(HAVE_RU_IDRSS)
418 struct rusage usage;
419
420 if ( getrusage(RUSAGE_SELF, &usage) == 0 &&
421 usage.ru_idrss )
422 { return usage.ru_idrss; /* total unshared data */
423 }
424 #endif
425
426 return (GD->statistics.heap +
427 usedStack(global) +
428 usedStack(local) +
429 usedStack(trail));
430 }
431
432
433 uintptr_t
FreeMemory(void)434 FreeMemory(void)
435 {
436 #if defined(HAVE_GETRLIMIT) && defined(RLIMIT_DATA)
437 uintptr_t used = UsedMemory();
438
439 struct rlimit limit;
440
441 if ( getrlimit(RLIMIT_DATA, &limit) == 0 )
442 return limit.rlim_cur - used;
443 #endif
444
445 return 0L;
446 }
447
448
449 /********************************
450 * ARITHMETIC *
451 *********************************/
452
453 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
454 uint64_t _PL_Random()
455
456 Return a random number. Used for arithmetic only. More trouble. On
457 some systems (__WINDOWS__) the seed of rand() is thread-local, while on
458 others it is global. We appear to have the choice between
459
460 # srand()/rand()
461 Differ in MT handling, often bad distribution
462
463 # srandom()/random()
464 Not portable, not MT-Safe but much better distribution
465
466 # drand48() and friends
467 Depreciated according to Linux manpage, suggested by Solaris
468 manpage.
469 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
470 #ifdef __MINGW32__
471 __stdcall unsigned long GetTickCount(void);
472 #endif
473
474 void
setRandom(unsigned int * seedp)475 setRandom(unsigned int *seedp)
476 { unsigned int seed;
477
478 if ( seedp )
479 { seed = *seedp;
480 } else
481 {
482 #ifdef __WINDOWS__
483 seed = (unsigned int)GetTickCount();
484 #else
485 #ifdef HAVE_GETTIMEOFDAY
486 struct timeval tp;
487
488 gettimeofday(&tp, NULL);
489 seed = (unsigned int)(tp.tv_sec + tp.tv_usec);
490 #else
491 seed = (unsigned int)time((time_t *) NULL);
492 #endif
493 #endif
494 }
495
496 #ifdef HAVE_SRANDOM
497 srandom(seed);
498 #else
499 #ifdef HAVE_SRAND
500 srand(seed);
501 #endif
502 #endif
503 }
504
505 uint64_t
_PL_Random(void)506 _PL_Random(void)
507 { GET_LD
508
509 if ( !LD->os.rand_initialised )
510 { setRandom(NULL);
511 LD->os.rand_initialised = TRUE;
512 }
513
514 #ifdef HAVE_RANDOM
515 #if SIZEOF_VOIDP == 4
516 { uint64_t l = random();
517
518 l ^= (uint64_t)random()<<32;
519
520 return l;
521 }
522 #else
523 return random();
524 #endif
525 #else
526 { uint64_t l = rand(); /* 0<n<2^15-1 */
527
528 l ^= (uint64_t)rand()<<15;
529 l ^= (uint64_t)rand()<<30;
530 l ^= (uint64_t)rand()<<45;
531
532 return l;
533 }
534 #endif
535 }
536
537 /********************************
538 * FILES *
539 *********************************/
540
541 /* (Everything you always wanted to know about files ...) */
542
543 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
544 Generation and administration of temporary files. Currently only used
545 by the foreign language linker. It might be useful to make a predicate
546 available to the Prolog user based on these functions. These functions
547 are in this module as non-UNIX OS probably don't have getpid() or put
548 temporaries on /tmp.
549
550 atom_t TemporaryFile(const char *id, int *fdp)
551
552 The return value of this call is an atom, whose string represents
553 the path name of a unique file that can be used as temporary file.
554 `id' is a char * that can be used to make it easier to identify the
555 file as a specific kind of SWI-Prolog intermediate file.
556
557 void RemoveTemporaryFiles()
558
559 Remove all temporary files. This function should be aware of the
560 fact that some of the file names generated by TemporaryFile() might
561 not be created at all, or might already have been deleted.
562 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
563
564 #ifndef DEFTMPDIR
565 #ifdef __WINDOWS__
566 #define DEFTMPDIR "c:/tmp"
567 #else
568 #define DEFTMPDIR "/tmp"
569 #endif
570 #endif
571
572 static int
free_tmp_symbol(Symbol s)573 free_tmp_symbol(Symbol s)
574 { int rc;
575 atom_t tname = (atom_t)s->name;
576 PL_chars_t txt;
577
578 get_atom_text(tname, &txt);
579 PL_mb_text(&txt, REP_FN);
580 rc = RemoveFile(txt.text.t);
581 PL_free_text(&txt);
582
583 PL_unregister_atom(tname);
584 return rc;
585 }
586
587
588 static void
void_free_tmp_symbol(Symbol s)589 void_free_tmp_symbol(Symbol s)
590 { (void)free_tmp_symbol(s);
591 }
592
593
594 #ifndef O_EXCL
595 #define O_EXCL 0
596 #endif
597 #ifndef O_BINARY
598 #define O_BINARY 0
599 #endif
600
601 atom_t
TemporaryFile(const char * id,int * fdp)602 TemporaryFile(const char *id, int *fdp)
603 { char temp[MAXPATHLEN];
604 static char *tmpdir = NULL;
605 atom_t tname;
606 int retries = 0;
607
608 if ( !tmpdir )
609 { LOCK();
610 if ( !tmpdir )
611 { char envbuf[MAXPATHLEN];
612 char *td;
613
614 if ( (td = Getenv("TEMP", envbuf, sizeof(envbuf))) ||
615 (td = Getenv("TMP", envbuf, sizeof(envbuf))) )
616 tmpdir = strdup(td);
617 else
618 tmpdir = DEFTMPDIR;
619 }
620 UNLOCK();
621 }
622
623 retry:
624 #ifdef __unix__
625 { static int MTOK_temp_counter = 0;
626 const char *sep = id[0] ? "_" : "";
627
628 Ssprintf(temp, "%s/pl_%s%s%d_%d",
629 tmpdir, id, sep, (int) getpid(), MTOK_temp_counter++);
630 }
631 #endif
632
633 #ifdef __WINDOWS__
634 { char *tmp;
635 static int temp_counter = 0;
636
637 #ifdef __LCC__
638 if ( (tmp = tmpnam(NULL)) )
639 #else
640 if ( (tmp = _tempnam(tmpdir, id)) )
641 #endif
642 { PrologPath(tmp, temp, sizeof(temp));
643 } else
644 { const char *sep = id[0] ? "_" : "";
645
646 Ssprintf(temp, "%s/pl_%s%s%d", tmpdir, id, sep, temp_counter++);
647 }
648 }
649 #endif
650
651 if ( fdp )
652 { int fd;
653
654 if ( (fd=open(temp, O_CREAT|O_EXCL|O_WRONLY|O_BINARY, 0600)) < 0 )
655 { if ( ++retries < 10000 )
656 goto retry;
657 else
658 return NULL_ATOM;
659 }
660
661 *fdp = fd;
662 }
663
664 tname = PL_new_atom(temp); /* locked: ok! */
665
666 LOCK();
667 if ( !GD->os.tmp_files )
668 { GD->os.tmp_files = newHTable(4);
669 GD->os.tmp_files->free_symbol = void_free_tmp_symbol;
670 }
671 UNLOCK();
672
673 addHTable(GD->os.tmp_files, (void*)tname, (void*)TRUE);
674
675 return tname;
676 }
677
678
679 int
DeleteTemporaryFile(atom_t name)680 DeleteTemporaryFile(atom_t name)
681 { int rc = FALSE;
682
683 if ( GD->os.tmp_files )
684 { LOCK();
685 if ( GD->os.tmp_files && GD->os.tmp_files->size > 0 )
686 { Symbol s = lookupHTable(GD->os.tmp_files, (void*)name);
687
688 if ( s )
689 { rc = free_tmp_symbol(s);
690 deleteSymbolHTable(GD->os.tmp_files, s);
691 }
692 }
693 UNLOCK();
694 }
695
696 return rc;
697 }
698
699
700 void
RemoveTemporaryFiles(void)701 RemoveTemporaryFiles(void)
702 { LOCK();
703 if ( GD->os.tmp_files )
704 { Table t = GD->os.tmp_files;
705
706 GD->os.tmp_files = NULL;
707 UNLOCK();
708 destroyHTable(t);
709 } else
710 { UNLOCK();
711 }
712 }
713
714
715 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
716 Size of a VM page of memory. Most BSD machines have this function. If not,
717 here are several alternatives ...
718 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
719
720 #ifndef HAVE_GETPAGESIZE
721 #ifdef _SC_PAGESIZE
722 int
getpagesize()723 getpagesize()
724 { return sysconf(_SC_PAGESIZE);
725 }
726 #else /*_SC_PAGESIZE*/
727
728 #if hpux
729 #include <a.out.h>
730 int
getpagesize()731 getpagesize()
732 {
733 #ifdef EXEC_PAGESIZE
734 return EXEC_PAGESIZE;
735 #else
736 return 4096; /* not that important */
737 #endif
738 }
739 #endif /*hpux*/
740 #endif /*_SC_PAGESIZE*/
741 #endif /*HAVE_GETPAGESIZE*/
742
743 #if O_HPFS
744
745 /* Conversion rules Prolog <-> OS/2 (using HPFS)
746 / <-> \
747 /x:/ <-> x:\ (embedded drive letter)
748 No length restrictions up to MAXPATHLEN, no case conversions.
749 */
750
751 char *
PrologPath(char * ospath,char * path,size_t len)752 PrologPath(char *ospath, char *path, size_t len)
753 { char *s = ospath, *p = path;
754 int limit = len-1;
755
756 if (isLetter(s[0]) && s[1] == ':')
757 { *p++ = '/';
758 *p++ = *s++;
759 *p++ = *s++;
760 limit -= 3;
761 }
762 for(; *s && limit; s++, p++, limit--)
763 *p = (*s == '\\' ? '/' : makeLower(*s));
764 *p = EOS;
765
766 return path;
767 }
768
769
770 char *
OsPath(const char * plpath,char * path)771 OsPath(const char *plpath, char *path)
772 { const char *s = plpath, *p = path;
773 int limit = MAXPATHLEN-1;
774
775 if ( s[0] == '/' && isLetter(s[1]) && s[2] == ':') /* embedded drive letter*/
776 { s++;
777 *p++ = *s++;
778 *p++ = *s++;
779 if ( *s != '/' )
780 *p++ = '\\';
781 limit -= 2;
782 }
783
784 for(; *s && limit; s++, p++, limit--)
785 *p = (*s == '/' ? '\\' : *s);
786 if ( p[-1] == '\\' && p > path )
787 p--;
788 *p = EOS;
789
790 return path;
791 }
792 #endif /* O_HPFS */
793
794 #if defined(__unix__) || defined(__APPLE__)
795 char *
PrologPath(const char * p,char * buf,size_t len)796 PrologPath(const char *p, char *buf, size_t len)
797 { strncpy(buf, p, len);
798
799 return buf;
800 }
801
802 char *
OsPath(const char * p,char * buf)803 OsPath(const char *p, char *buf)
804 { strcpy(buf, p);
805
806 return buf;
807 }
808 #endif /*__unix__*/
809
810 #if O_XOS
811 char *
PrologPath(const char * p,char * buf,size_t len)812 PrologPath(const char *p, char *buf, size_t len)
813 { GET_LD
814 int flags = (truePrologFlag(PLFLAG_FILE_CASE) ? 0 : XOS_DOWNCASE);
815
816 return _xos_canonical_filename(p, buf, len, flags);
817 }
818
819 char *
OsPath(const char * p,char * buf)820 OsPath(const char *p, char *buf)
821 { strcpy(buf, p);
822
823 return buf;
824 }
825 #endif /* O_XOS */
826
827
828 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
829 char *AbsoluteFile(const char *file, char *path)
830
831 Expand a file specification to a system-wide unique description of
832 the file that can be passed to the file functions that take a path
833 as argument. Path should refer to the same file, regardless of the
834 current working directory. On Unix absolute file names are used
835 for this purpose.
836
837 This function is based on a similar (primitive) function in
838 Edinburgh C-Prolog.
839
840 char *BaseName(path)
841 char *path;
842
843 Return the basic file name for a file having path `path'.
844
845 char *DirName(const char *path, char *dir)
846
847 Return the directory name for a file having path `path'.
848 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
849
850 #if defined(HAVE_SYMLINKS) && (defined(HAVE_STAT) || defined(__unix__))
851 #define O_CANONISE_DIRS
852
853 struct canonical_dir
854 { char * name; /* name of directory */
855 char * canonical; /* canonical name of directory */
856 dev_t device; /* device number */
857 ino_t inode; /* inode number */
858 CanonicalDir next; /* next in chain */
859 };
860
861 #define canonical_dirlist (GD->os._canonical_dirlist)
862
863 forwards char *canoniseDir(char *);
864 #endif /*O_CANONISE_DIRS*/
865
866 #define CWDdir (LD->os._CWDdir) /* current directory */
867 #define CWDlen (LD->os._CWDlen) /* strlen(CWDdir) */
868
869 static void
initExpand(void)870 initExpand(void)
871 { GET_LD
872 #ifdef O_CANONISE_DIRS
873 char *dir;
874 char *cpaths;
875 #endif
876
877 CWDdir = NULL;
878 CWDlen = 0;
879
880 #ifdef O_CANONISE_DIRS
881 { char envbuf[MAXPATHLEN];
882
883 if ( (cpaths = Getenv("CANONICAL_PATHS", envbuf, sizeof(envbuf))) )
884 { char buf[MAXPATHLEN];
885
886 while(*cpaths)
887 { char *e;
888
889 if ( (e = strchr(cpaths, ':')) )
890 { int l = e-cpaths;
891
892 strncpy(buf, cpaths, l);
893 buf[l] = EOS;
894 cpaths += l+1;
895 canoniseDir(buf);
896 } else
897 { canoniseDir(cpaths);
898 break;
899 }
900 }
901 }
902
903 if ( (dir = Getenv("HOME", envbuf, sizeof(envbuf))) ) canoniseDir(dir);
904 if ( (dir = Getenv("PWD", envbuf, sizeof(envbuf))) ) canoniseDir(dir);
905 if ( (dir = Getenv("CWD", envbuf, sizeof(envbuf))) ) canoniseDir(dir);
906 }
907 #endif
908 }
909
910 #ifdef O_CANONISE_DIRS
911
912 static void
cleanupExpand(void)913 cleanupExpand(void)
914 { CanonicalDir dn = canonical_dirlist, next;
915
916 canonical_dirlist = NULL;
917 for( ; dn; dn = next )
918 { next = dn->next;
919 free(dn);
920 }
921 }
922
923
924 static void
registerParentDirs(const char * path)925 registerParentDirs(const char *path)
926 { const char *e = path + strlen(path);
927
928 while(e>path)
929 { char dirname[MAXPATHLEN];
930 char tmp[MAXPATHLEN];
931 CanonicalDir d;
932 struct stat buf;
933
934 for(e--; *e != '/' && e > path + 1; e-- )
935 ;
936
937 strncpy(dirname, path, e-path);
938 dirname[e-path] = EOS;
939
940 for(d = canonical_dirlist; d; d = d->next)
941 { if ( streq(d->name, dirname) )
942 return;
943 }
944
945 if ( statfunc(OsPath(dirname, tmp), &buf) == 0 )
946 { CanonicalDir dn = malloc(sizeof(*dn));
947
948 dn->name = store_string(dirname);
949 dn->inode = buf.st_ino;
950 dn->device = buf.st_dev;
951 dn->canonical = dn->name;
952 dn->next = canonical_dirlist;
953 canonical_dirlist = dn;
954
955 DEBUG(1, Sdprintf("Registered canonical dir %s\n", dirname));
956 } else
957 return;
958 }
959 }
960
961
962 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
963 verify_entry() verifies the path cache for this path is still safe. If
964 not it updates the cache and returns FALSE.
965 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
966
967 static int
verify_entry(CanonicalDir d)968 verify_entry(CanonicalDir d)
969 { char tmp[MAXPATHLEN];
970 struct stat buf;
971
972 if ( statfunc(OsPath(d->canonical, tmp), &buf) == 0 )
973 { if ( d->inode == buf.st_ino &&
974 d->device == buf.st_dev )
975 return TRUE;
976
977 DEBUG(1, Sdprintf("%s: inode/device changed\n", d->canonical));
978
979 d->inode = buf.st_ino;
980 d->device = buf.st_dev;
981 return TRUE;
982 } else
983 { DEBUG(1, Sdprintf("%s: no longer exists\n", d->canonical));
984
985 if ( d == canonical_dirlist )
986 { canonical_dirlist = d->next;
987 } else
988 { CanonicalDir cd;
989
990 for(cd=canonical_dirlist; cd; cd=cd->next)
991 { if ( cd->next == d )
992 { cd->next = d->next;
993 break;
994 }
995 }
996 }
997
998 remove_string(d->name);
999 if ( d->canonical != d->name )
1000 remove_string(d->canonical);
1001 free(d);
1002 }
1003
1004 return FALSE;
1005 }
1006
1007
1008 static char *
canoniseDir(char * path)1009 canoniseDir(char *path)
1010 { CanonicalDir d, next;
1011 struct stat buf;
1012 char tmp[MAXPATHLEN];
1013
1014 DEBUG(1, Sdprintf("canoniseDir(%s) --> ", path));
1015
1016 for(d = canonical_dirlist; d; d = next)
1017 { next = d->next;
1018
1019 if ( streq(d->name, path) && verify_entry(d) )
1020 { if ( d->name != d->canonical )
1021 strcpy(path, d->canonical);
1022
1023 DEBUG(1, Sdprintf("(lookup) %s\n", path));
1024 return path;
1025 }
1026 }
1027
1028 /* we need to use malloc() here */
1029 /* because allocHeap() only ensures */
1030 /* alignment for `word', and inode_t */
1031 /* is sometimes bigger! */
1032
1033 if ( statfunc(OsPath(path, tmp), &buf) == 0 )
1034 { CanonicalDir dn = malloc(sizeof(*dn));
1035 char dirname[MAXPATHLEN];
1036 char *e = path + strlen(path);
1037
1038 dn->name = store_string(path);
1039 dn->inode = buf.st_ino;
1040 dn->device = buf.st_dev;
1041
1042 do
1043 { strncpy(dirname, path, e-path);
1044 dirname[e-path] = EOS;
1045 if ( statfunc(OsPath(dirname, tmp), &buf) < 0 )
1046 break;
1047
1048 DEBUG(2, Sdprintf("Checking %s (dev=%d,ino=%d)\n",
1049 dirname, buf.st_dev, buf.st_ino));
1050
1051 for(d = canonical_dirlist; d; d = next)
1052 { next = d->next;
1053
1054 if ( d->inode == buf.st_ino && d->device == buf.st_dev &&
1055 verify_entry(d) )
1056 { DEBUG(2, Sdprintf("Hit with %s (dev=%d,ino=%d)\n",
1057 d->canonical, d->device, d->inode));
1058
1059 strcpy(dirname, d->canonical);
1060 strcat(dirname, e);
1061 strcpy(path, dirname);
1062 dn->canonical = store_string(path);
1063 dn->next = canonical_dirlist;
1064 canonical_dirlist = dn;
1065 DEBUG(1, Sdprintf("(replace) %s\n", path));
1066 registerParentDirs(path);
1067 return path;
1068 }
1069 }
1070
1071 for(e--; *e != '/' && e > path + 1; e-- )
1072 ;
1073 } while( e > path );
1074
1075 dn->canonical = dn->name;
1076 dn->next = canonical_dirlist;
1077 canonical_dirlist = dn;
1078
1079 DEBUG(1, Sdprintf("(new, existing) %s\n", path));
1080 registerParentDirs(path);
1081 return path;
1082 }
1083
1084 DEBUG(1, Sdprintf("(nonexisting) %s\n", path));
1085 return path;
1086 }
1087
1088 #else
1089
1090 #define canoniseDir(d)
1091
1092 static void
cleanupExpand(void)1093 cleanupExpand(void)
1094 {
1095 }
1096
1097 #endif /*O_CANONISE_DIRS*/
1098
1099
1100 char *
canoniseFileName(char * path)1101 canoniseFileName(char *path)
1102 { char *out = path, *in = path, *start = path;
1103 char *osave[100];
1104 int osavep = 0;
1105
1106 #ifdef O_HASDRIVES /* C: */
1107 if ( in[1] == ':' && isLetter(in[0]) )
1108 { in += 2;
1109
1110 out = start = in;
1111 }
1112 #endif
1113 #ifdef O_HASSHARES /* //host/ */
1114 if ( in[0] == '/' && in[1] == '/' && isAlpha(in[2]) )
1115 { char *s;
1116
1117 for(s = in+3; *s && (isAlpha(*s) || *s == '.'); s++)
1118 ;
1119 if ( *s == '/' )
1120 { in = out = s+1;
1121 start = in-1;
1122 }
1123 }
1124 #endif
1125
1126 while( in[0] == '/' && in[1] == '.' && in[2] == '.' && in[3] == '/' )
1127 in += 3;
1128 while( in[0] == '.' && in[1] == '/' )
1129 in += 2;
1130 if ( in[0] == '/' )
1131 *out++ = '/';
1132 osave[osavep++] = out;
1133
1134 while(*in)
1135 { if (*in == '/')
1136 {
1137 again:
1138 if ( *in )
1139 { while( in[1] == '/' ) /* delete multiple / */
1140 in++;
1141 if ( in[1] == '.' )
1142 { if ( in[2] == '/' ) /* delete /./ */
1143 { in += 2;
1144 goto again;
1145 }
1146 if ( in[2] == EOS ) /* delete trailing /. */
1147 { *out = EOS;
1148 return path;
1149 }
1150 if ( in[2] == '.' && (in[3] == '/' || in[3] == EOS) )
1151 { if ( osavep > 0 ) /* delete /foo/../ */
1152 { out = osave[--osavep];
1153 in += 3;
1154 if ( in[0] == EOS && out > start+1 )
1155 { out[-1] = EOS; /* delete trailing / */
1156 return path;
1157 }
1158 goto again;
1159 } else if ( start[0] == '/' && out == start+1 )
1160 { in += 3;
1161 goto again;
1162 }
1163 }
1164 }
1165 }
1166 if ( *in )
1167 in++;
1168 if ( out > path && out[-1] != '/' )
1169 *out++ = '/';
1170 osave[osavep++] = out;
1171 } else
1172 *out++ = *in++;
1173 }
1174 *out++ = *in++;
1175
1176 return path;
1177 }
1178
1179
1180 static char *
utf8_strlwr(char * s)1181 utf8_strlwr(char *s)
1182 { char tmp[MAXPATHLEN];
1183 char *o, *i;
1184
1185 strcpy(tmp, s);
1186 for(i=tmp, o=s; *i; )
1187 { int c;
1188
1189 i = utf8_get_char(i, &c);
1190 c = towlower((wint_t)c);
1191 o = utf8_put_char(o, c);
1192 }
1193 *o = EOS;
1194
1195 return s;
1196 }
1197
1198
1199 char *
canonisePath(char * path)1200 canonisePath(char *path)
1201 { GET_LD
1202
1203 if ( !truePrologFlag(PLFLAG_FILE_CASE) )
1204 utf8_strlwr(path);
1205
1206 canoniseFileName(path);
1207
1208 #ifdef O_CANONISE_DIRS
1209 { char *e;
1210 char dirname[MAXPATHLEN];
1211
1212 e = path + strlen(path) - 1;
1213 for( ; *e != '/' && e > path; e-- )
1214 ;
1215 strncpy(dirname, path, e-path);
1216 dirname[e-path] = EOS;
1217 canoniseDir(dirname);
1218 strcat(dirname, e);
1219 strcpy(path, dirname);
1220 }
1221 #endif
1222
1223 return path;
1224 }
1225
1226
1227 static char *
takeWord(const char ** string,char * wrd,int maxlen)1228 takeWord(const char **string, char *wrd, int maxlen)
1229 { const char *s = *string;
1230 char *q = wrd;
1231 int left = maxlen-1;
1232
1233 while( isAlpha(*s) || *s == '_' )
1234 { if ( --left < 0 )
1235 { PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
1236 ATOM_max_variable_length);
1237 return NULL;
1238 }
1239 *q++ = *s++;
1240 }
1241 *q = EOS;
1242
1243 *string = s;
1244 return wrd;
1245 }
1246
1247
1248 bool
expandVars(const char * pattern,char * expanded,int maxlen)1249 expandVars(const char *pattern, char *expanded, int maxlen)
1250 { GET_LD
1251 int size = 0;
1252 char wordbuf[MAXPATHLEN];
1253
1254 if ( *pattern == '~' )
1255 { char *user;
1256 char *value;
1257 int l;
1258
1259 pattern++;
1260 user = takeWord(&pattern, wordbuf, sizeof(wordbuf));
1261 LOCK();
1262
1263 if ( user[0] == EOS ) /* ~/bla */
1264 {
1265 #ifdef O_XOS
1266 value = _xos_home();
1267 #else /*O_XOS*/
1268 if ( !(value = GD->os.myhome) )
1269 { char envbuf[MAXPATHLEN];
1270
1271 if ( (value = Getenv("HOME", envbuf, sizeof(envbuf))) &&
1272 (value = PrologPath(value, wordbuf, sizeof(wordbuf))) )
1273 { GD->os.myhome = store_string(value);
1274 } else
1275 { value = GD->os.myhome = store_string("/");
1276 }
1277 }
1278 #endif /*O_XOS*/
1279 } else /* ~fred */
1280 #ifdef HAVE_GETPWNAM
1281 { struct passwd *pwent;
1282
1283 if ( GD->os.fred && streq(GD->os.fred, user) )
1284 { value = GD->os.fredshome;
1285 } else
1286 { if ( !(pwent = getpwnam(user)) )
1287 { if ( truePrologFlag(PLFLAG_FILEERRORS) )
1288 { term_t name = PL_new_term_ref();
1289
1290 PL_put_atom_chars(name, user);
1291 PL_error(NULL, 0, NULL, ERR_EXISTENCE, ATOM_user, name);
1292 }
1293 UNLOCK();
1294 fail;
1295 }
1296 if ( GD->os.fred )
1297 remove_string(GD->os.fred);
1298 if ( GD->os.fredshome )
1299 remove_string(GD->os.fredshome);
1300
1301 GD->os.fred = store_string(user);
1302 value = GD->os.fredshome = store_string(pwent->pw_dir);
1303 }
1304 }
1305 #else
1306 { if ( truePrologFlag(PLFLAG_FILEERRORS) )
1307 PL_error(NULL, 0, NULL, ERR_NOT_IMPLEMENTED, "user_info");
1308
1309 UNLOCK();
1310 fail;
1311 }
1312 #endif
1313 size += (l = (int) strlen(value));
1314 if ( size+1 >= maxlen )
1315 return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
1316 strcpy(expanded, value);
1317 expanded += l;
1318 UNLOCK();
1319
1320 /* ~/ should not become // */
1321 if ( expanded[-1] == '/' && pattern[0] == '/' )
1322 pattern++;
1323 }
1324
1325 for( ;; )
1326 { int c = *pattern++;
1327
1328 switch( c )
1329 { case EOS:
1330 break;
1331 case '$':
1332 { char envbuf[MAXPATHLEN];
1333 char *var = takeWord(&pattern, wordbuf, sizeof(wordbuf));
1334 char *value;
1335 int l;
1336
1337 if ( var[0] == EOS )
1338 goto def;
1339 LOCK();
1340 value = Getenv(var, envbuf, sizeof(envbuf));
1341 if ( value == (char *) NULL )
1342 { if ( truePrologFlag(PLFLAG_FILEERRORS) )
1343 { term_t name = PL_new_term_ref();
1344
1345 PL_put_atom_chars(name, var);
1346 PL_error(NULL, 0, NULL, ERR_EXISTENCE, ATOM_variable, name);
1347 }
1348
1349 UNLOCK();
1350 fail;
1351 }
1352 size += (l = (int)strlen(value));
1353 if ( size+1 >= maxlen )
1354 { UNLOCK();
1355 return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
1356 ATOM_max_path_length);
1357 }
1358 strcpy(expanded, value);
1359 UNLOCK();
1360
1361 expanded += l;
1362
1363 continue;
1364 }
1365 default:
1366 def:
1367 size++;
1368 if ( size+1 >= maxlen )
1369 return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
1370 ATOM_max_path_length);
1371 *expanded++ = c;
1372
1373 continue;
1374 }
1375 break;
1376 }
1377
1378 if ( ++size >= maxlen )
1379 return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
1380 ATOM_max_path_length);
1381 *expanded = EOS;
1382
1383 succeed;
1384 }
1385
1386
1387 static int
ExpandFile(const char * pattern,char ** vector)1388 ExpandFile(const char *pattern, char **vector)
1389 { char expanded[MAXPATHLEN];
1390 int matches = 0;
1391
1392 if ( !expandVars(pattern, expanded, sizeof(expanded)) )
1393 return -1;
1394
1395 vector[matches++] = store_string(expanded);
1396
1397 return matches;
1398 }
1399
1400
1401 char *
ExpandOneFile(const char * spec,char * file)1402 ExpandOneFile(const char *spec, char *file)
1403 { GET_LD
1404 char *vector[256];
1405 int size;
1406
1407 switch( (size=ExpandFile(spec, vector)) )
1408 { case -1:
1409 return NULL;
1410 case 0:
1411 { term_t tmp = PL_new_term_ref();
1412
1413 PL_put_atom_chars(tmp, spec);
1414 PL_error(NULL, 0, "no match", ERR_EXISTENCE, ATOM_file, tmp);
1415
1416 return NULL;
1417 }
1418 case 1:
1419 strcpy(file, vector[0]);
1420 remove_string(vector[0]);
1421 return file;
1422 default:
1423 { term_t tmp = PL_new_term_ref();
1424 int n;
1425
1426 for(n=0; n<size; n++)
1427 remove_string(vector[n]);
1428 PL_put_atom_chars(tmp, spec);
1429 PL_error(NULL, 0, "ambiguous", ERR_EXISTENCE, ATOM_file, tmp);
1430
1431 return NULL;
1432 }
1433 }
1434 }
1435
1436
1437 #ifdef O_HASDRIVES
1438
1439 #define IS_DIR_SEPARATOR(c) ((c) == '/' || (c) == '\\')
1440
1441 int
IsAbsolutePath(const char * p)1442 IsAbsolutePath(const char *p) /* /d:/ */
1443 { if ( p[0] == '/' && p[2] == ':' && isLetter(p[1]) &&
1444 (p[3] == '/' || p[3] == '\0') )
1445 succeed;
1446
1447 if ( p[1] == ':' && isLetter(p[0]) && /* d:/ or d:\ */
1448 (IS_DIR_SEPARATOR(p[2]) || p[2] == '\0') )
1449 succeed;
1450
1451 #ifdef O_HASSHARES
1452 if ( (p[0] == '/' && p[1] == '/') || /* //host/share */
1453 (p[0] == '\\' && p[1] == '\\') ) /* \\host\share */
1454 succeed;
1455 #endif
1456
1457 fail;
1458 }
1459
1460
1461 static inline int
isDriveRelativePath(const char * p)1462 isDriveRelativePath(const char *p) /* '/...' */
1463 { return IS_DIR_SEPARATOR(p[0]) && !IsAbsolutePath(p);
1464 }
1465
1466 #ifdef __WINDOWS__
1467 #undef mkdir
1468 #include <direct.h>
1469 #define mkdir _xos_mkdir
1470 #endif
1471
1472 static int
GetCurrentDriveLetter()1473 GetCurrentDriveLetter()
1474 {
1475 #ifdef OS2
1476 return _getdrive();
1477 #endif
1478 #ifdef __WINDOWS__
1479 return _getdrive() + 'a' - 1;
1480 #endif
1481 #ifdef __WATCOMC__
1482 { unsigned drive;
1483 _dos_getdrive(&drive);
1484 return = 'a' + drive - 1;
1485 }
1486 #endif
1487 }
1488
1489 #else /*O_HASDRIVES*/
1490
1491 int
IsAbsolutePath(const char * p)1492 IsAbsolutePath(const char *p)
1493 { return p[0] == '/';
1494 }
1495
1496 #endif /*O_HASDRIVES*/
1497
1498 #define isRelativePath(p) ( p[0] == '.' )
1499
1500
1501 char *
AbsoluteFile(const char * spec,char * path)1502 AbsoluteFile(const char *spec, char *path)
1503 { GET_LD
1504 char tmp[MAXPATHLEN];
1505 char buf[MAXPATHLEN];
1506 char *file = PrologPath(spec, buf, sizeof(buf));
1507
1508 if ( !file )
1509 return (char *) NULL;
1510 if ( truePrologFlag(PLFLAG_FILEVARS) )
1511 { if ( !(file = ExpandOneFile(buf, tmp)) )
1512 return (char *) NULL;
1513 }
1514
1515 if ( IsAbsolutePath(file) )
1516 { strcpy(path, file);
1517
1518 return canonisePath(path);
1519 }
1520
1521 #ifdef O_HASDRIVES
1522 if ( isDriveRelativePath(file) ) /* /something --> d:/something */
1523 { if ((strlen(file) + 3) > MAXPATHLEN)
1524 { PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
1525 return (char *) NULL;
1526 }
1527 path[0] = GetCurrentDriveLetter();
1528 path[1] = ':';
1529 strcpy(&path[2], file);
1530 return canonisePath(path);
1531 }
1532 #endif /*O_HASDRIVES*/
1533
1534 if ( !PL_cwd() )
1535 return NULL;
1536
1537 if ( (CWDlen + strlen(file) + 1) >= MAXPATHLEN )
1538 { PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
1539 return (char *) NULL;
1540 }
1541
1542 strcpy(path, CWDdir);
1543 if ( file[0] != EOS )
1544 strcpy(&path[CWDlen], file);
1545 if ( strchr(file, '.') || strchr(file, '/') )
1546 return canonisePath(path);
1547 else
1548 return path;
1549 }
1550
1551
1552 void
PL_changed_cwd(void)1553 PL_changed_cwd(void)
1554 { GET_LD
1555
1556 if ( CWDdir )
1557 remove_string(CWDdir);
1558 CWDdir = NULL;
1559 CWDlen = 0;
1560 }
1561
1562
1563 const char *
PL_cwd(void)1564 PL_cwd(void)
1565 { GET_LD
1566
1567 if ( CWDlen == 0 )
1568 { char buf[MAXPATHLEN];
1569 char *rval;
1570
1571 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1572 On SunOs, getcwd() is using popen() to read the output of /bin/pwd. This
1573 is slow and appears not to cooperate with profile/3. getwd() is supposed
1574 to be implemented directly. What about other Unixes?
1575 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1576
1577 #if defined(HAVE_GETWD) && (defined(__sun__) || defined(__sun))
1578 #undef HAVE_GETCWD
1579 #endif
1580
1581 #if defined(HAVE_GETWD) && !defined(HAVE_GETCWD)
1582 rval = getwd(buf);
1583 #else
1584 rval = getcwd(buf, sizeof(buf));
1585 #endif
1586 if ( !rval )
1587 { term_t tmp = PL_new_term_ref();
1588
1589 PL_put_atom(tmp, ATOM_dot);
1590 PL_error(NULL, 0, OsError(), ERR_FILE_OPERATION,
1591 ATOM_getcwd, ATOM_directory, tmp);
1592
1593 return NULL;
1594 }
1595
1596 canonisePath(buf);
1597 CWDlen = strlen(buf);
1598 buf[CWDlen++] = '/';
1599 buf[CWDlen] = EOS;
1600
1601 if ( CWDdir )
1602 remove_string(CWDdir);
1603 CWDdir = store_string(buf);
1604 }
1605
1606 return (const char *)CWDdir;
1607 }
1608
1609
1610 char *
BaseName(const char * f)1611 BaseName(const char *f)
1612 { const char *base;
1613
1614 for(base = f; *f; f++)
1615 { if (*f == '/')
1616 base = f+1;
1617 }
1618
1619 return (char *)base;
1620 }
1621
1622
1623 char *
DirName(const char * f,char * dir)1624 DirName(const char *f, char *dir)
1625 { const char *base, *p;
1626
1627 for(base = p = f; *p; p++)
1628 { if (*p == '/' && p[1] != EOS )
1629 base = p;
1630 }
1631 if ( base == f )
1632 { if ( *f == '/' )
1633 strcpy(dir, "/");
1634 else
1635 strcpy(dir, ".");
1636 } else
1637 { if ( dir != f ) /* otherwise it is in-place */
1638 strncpy(dir, f, base-f);
1639 dir[base-f] = EOS;
1640 }
1641
1642 return dir;
1643 }
1644
1645
1646 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1647 bool ChDir(path)
1648 char *path;
1649
1650 Change the current working directory to `path'. File names may depend
1651 on `path'.
1652 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1653
1654 bool
ChDir(const char * path)1655 ChDir(const char *path)
1656 { GET_LD
1657 char ospath[MAXPATHLEN];
1658 char tmp[MAXPATHLEN];
1659
1660 OsPath(path, ospath);
1661
1662 if ( path[0] == EOS || streq(path, ".") ||
1663 (CWDdir && streq(path, CWDdir)) )
1664 succeed;
1665
1666 AbsoluteFile(path, tmp);
1667
1668 if ( chdir(ospath) == 0 )
1669 { size_t len;
1670
1671 len = strlen(tmp);
1672 if ( len == 0 || tmp[len-1] != '/' )
1673 { tmp[len++] = '/';
1674 tmp[len] = EOS;
1675 }
1676 CWDlen = len;
1677 if ( CWDdir )
1678 remove_string(CWDdir);
1679 CWDdir = store_string(tmp);
1680
1681 succeed;
1682 }
1683
1684 fail;
1685 }
1686
1687
1688 /********************************
1689 * TIME CONVERSION *
1690 *********************************/
1691
1692 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1693 struct tm *LocalTime(time_t time, struct tm *r)
1694
1695 Convert time in Unix internal form (seconds since Jan 1 1970) into a
1696 structure providing easier access to the time.
1697
1698 For non-Unix systems: struct time is supposed to look like this.
1699 Move This definition to pl-os.h and write the conversion functions
1700 here.
1701
1702 struct tm {
1703 int tm_sec; / * second in the minute (0-59)* /
1704 int tm_min; / * minute in the hour (0-59) * /
1705 int tm_hour; / * hour of the day (0-23) * /
1706 int tm_mday; / * day of the month (1-31) * /
1707 int tm_mon; / * month of the year (1-12) * /
1708 int tm_year; / * year (0 = 1900) * /
1709 int tm_wday; / * day in the week (1-7, 1 = sunday) * /
1710 int tm_yday; / * day in the year (0-365) * /
1711 int tm_isdst; / * daylight saving time info * /
1712 };
1713
1714 time_t Time()
1715
1716 Return time in seconds after Jan 1 1970 (Unix' time notion).
1717 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1718
1719 struct tm *
LocalTime(long * t,struct tm * r)1720 LocalTime(long *t, struct tm *r)
1721 {
1722 #if defined(_REENTRANT) && defined(HAVE_LOCALTIME_R)
1723 return localtime_r(t, r);
1724 #else
1725 *r = *localtime((const time_t *) t);
1726 return r;
1727 #endif
1728 }
1729
1730
1731 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1732 TERMINAL IO MANIPULATION
1733
1734 ResetStdin()
1735 Clear the Sinput buffer after a saved state. Only necessary
1736 if O_SAVE is defined.
1737
1738 PushTty(IOSTREAM *s, ttybuf *buf, int state)
1739 Push the tty to the specified state and save the old state in
1740 buf.
1741
1742 PopTty(IOSTREAM *s, ttybuf *buf)
1743 Restore the tty state.
1744 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1745
1746 static void
ResetStdin(void)1747 ResetStdin(void)
1748 { Sinput->limitp = Sinput->bufp = Sinput->buffer;
1749 if ( !GD->os.org_terminal.read )
1750 GD->os.org_terminal = *Sinput->functions;
1751 }
1752
1753 static ssize_t
Sread_terminal(void * handle,char * buf,size_t size)1754 Sread_terminal(void *handle, char *buf, size_t size)
1755 { GET_LD
1756 intptr_t h = (intptr_t)handle;
1757 int fd = (int)h;
1758 source_location oldsrc = LD->read_source;
1759
1760 if ( LD->prompt.next && ttymode != TTY_RAW )
1761 PL_write_prompt(TRUE);
1762 else
1763 Sflush(Suser_output);
1764
1765 PL_dispatch(fd, PL_DISPATCH_WAIT);
1766 size = (*GD->os.org_terminal.read)(handle, buf, size);
1767
1768 if ( size == 0 ) /* end-of-file */
1769 { if ( fd == 0 )
1770 { Sclearerr(Suser_input);
1771 LD->prompt.next = TRUE;
1772 }
1773 } else if ( size > 0 && buf[size-1] == '\n' )
1774 LD->prompt.next = TRUE;
1775
1776 LD->read_source = oldsrc;
1777
1778 return size;
1779 }
1780
1781 void
ResetTty()1782 ResetTty()
1783 { GET_LD
1784 startCritical;
1785 ResetStdin();
1786
1787 if ( !GD->os.iofunctions.read )
1788 { GD->os.iofunctions = *Sinput->functions;
1789 GD->os.iofunctions.read = Sread_terminal;
1790
1791 Sinput->functions =
1792 Soutput->functions =
1793 Serror->functions = &GD->os.iofunctions;
1794 }
1795 LD->prompt.next = TRUE;
1796 endCritical;
1797 }
1798
1799 #ifdef O_HAVE_TERMIO /* sys/termios.h or sys/termio.h */
1800
1801 #ifndef HAVE_TCSETATTR
1802 #ifndef NO_SYS_IOCTL_H_WITH_SYS_TERMIOS_H
1803 #include <sys/ioctl.h>
1804 #endif
1805 #ifndef TIOCGETA
1806 #define TIOCGETA TCGETA
1807 #endif
1808 #endif
1809
1810 bool
PushTty(IOSTREAM * s,ttybuf * buf,int mode)1811 PushTty(IOSTREAM *s, ttybuf *buf, int mode)
1812 { GET_LD
1813 struct termios tio;
1814 int fd;
1815
1816 buf->mode = ttymode;
1817 ttymode = mode;
1818
1819 if ( (fd = Sfileno(s)) < 0 || !isatty(fd) )
1820 succeed; /* not a terminal */
1821 if ( !truePrologFlag(PLFLAG_TTY_CONTROL) )
1822 succeed;
1823
1824 #ifdef HAVE_TCSETATTR
1825 if ( tcgetattr(fd, &buf->tab) ) /* save the old one */
1826 fail;
1827 #else
1828 if ( ioctl(fd, TIOCGETA, &buf->tab) ) /* save the old one */
1829 fail;
1830 #endif
1831
1832 tio = buf->tab;
1833
1834 switch( mode )
1835 { case TTY_RAW:
1836 #if defined(HAVE_TCSETATTR) && defined(HAVE_CFMAKERAW)
1837 cfmakeraw(&tio);
1838 tio.c_oflag = buf->tab.c_oflag; /* donot change output modes */
1839 tio.c_lflag |= ISIG;
1840 #else
1841 tio.c_lflag &= ~(ECHO|ICANON);
1842 #endif
1843 /* OpenBSD requires this anyhow!? */
1844 /* Bug in OpenBSD or must we? */
1845 /* Could this do any harm? */
1846 tio.c_cc[VTIME] = 0, tio.c_cc[VMIN] = 1;
1847 break;
1848 case TTY_OUTPUT:
1849 tio.c_oflag |= (OPOST|ONLCR);
1850 break;
1851 case TTY_SAVE:
1852 succeed;
1853 default:
1854 sysError("Unknown PushTty() mode: %d", mode);
1855 /*NOTREACHED*/
1856 }
1857
1858 #ifdef HAVE_TCSETATTR
1859 if ( tcsetattr(fd, TCSANOW, &tio) != 0 )
1860 { static int MTOK_warned; /* MT-OK */
1861
1862 if ( !MTOK_warned++ )
1863 warning("Failed to set terminal: %s", OsError());
1864 }
1865 #else
1866 #ifdef TIOCSETAW
1867 ioctl(fd, TIOCSETAW, &tio);
1868 #else
1869 ioctl(fd, TCSETAW, &tio);
1870 ioctl(fd, TCXONC, (void *)1);
1871 #endif
1872 #endif
1873
1874 succeed;
1875 }
1876
1877
1878 bool
PopTty(IOSTREAM * s,ttybuf * buf)1879 PopTty(IOSTREAM *s, ttybuf *buf)
1880 { GET_LD
1881 int fd;
1882 ttymode = buf->mode;
1883
1884 if ( (fd = Sfileno(s)) < 0 || !isatty(fd) )
1885 succeed; /* not a terminal */
1886 if ( !truePrologFlag(PLFLAG_TTY_CONTROL) )
1887 succeed;
1888
1889 #ifdef HAVE_TCSETATTR
1890 tcsetattr(fd, TCSANOW, &buf->tab);
1891 #else
1892 #ifdef TIOCSETA
1893 ioctl(fd, TIOCSETA, &buf->tab);
1894 #else
1895 ioctl(fd, TCSETA, &buf->tab);
1896 ioctl(fd, TCXONC, (void *)1);
1897 #endif
1898 #endif
1899
1900 succeed;
1901 }
1902
1903 #else /* O_HAVE_TERMIO */
1904
1905 #ifdef HAVE_SGTTYB
1906
1907 bool
PushTty(IOSTREAM * s,ttybuf * buf,int mode)1908 PushTty(IOSTREAM *s, ttybuf *buf, int mode)
1909 { struct sgttyb tio;
1910 int fd;
1911
1912 buf->mode = ttymode;
1913 ttymode = mode;
1914
1915 if ( (fd = Sfileno(s)) < 0 || !isatty(fd) )
1916 succeed; /* not a terminal */
1917 if ( !truePrologFlag(PLFLAG_TTY_CONTROL) )
1918 succeed;
1919
1920 if ( ioctl(fd, TIOCGETP, &buf->tab) ) /* save the old one */
1921 fail;
1922 tio = buf->tab;
1923
1924 switch( mode )
1925 { case TTY_RAW:
1926 tio.sg_flags |= CBREAK;
1927 tio.sg_flags &= ~ECHO;
1928 break;
1929 case TTY_OUTPUT:
1930 tio.sg_flags |= (CRMOD);
1931 break;
1932 case TTY_SAVE:
1933 succeed;
1934 default:
1935 sysError("Unknown PushTty() mode: %d", mode);
1936 /*NOTREACHED*/
1937 }
1938
1939
1940 ioctl(fd, TIOCSETP, &tio);
1941 ioctl(fd, TIOCSTART, NULL);
1942
1943 succeed;
1944 }
1945
1946
1947 bool
PopTty(IOSTREAM * s,ttybuf * buf)1948 PopTty(IOSTREAM *s, ttybuf *buf)
1949 { ttymode = buf->mode;
1950 int fd;
1951
1952 if ( (fd = Sfileno(s)) < 0 || !isatty(fd) )
1953 succeed; /* not a terminal */
1954 if ( !truePrologFlag(PLFLAG_TTY_CONTROL) )
1955 succeed;
1956
1957 ioctl(fd, TIOCSETP, &buf->tab);
1958 ioctl(fd, TIOCSTART, NULL);
1959
1960 succeed;
1961 }
1962
1963 #else /*HAVE_SGTTYB*/
1964
1965 bool
PushTty(IOSTREAM * s,ttybuf * buf,int mode)1966 PushTty(IOSTREAM *s, ttybuf *buf, int mode)
1967 { buf->mode = ttymode;
1968 ttymode = mode;
1969
1970 succeed;
1971 }
1972
1973
1974 bool
PopTty(IOSTREAM * s,ttybuf * buf)1975 PopTty(IOSTREAM *s, ttybuf *buf)
1976 { GET_LD
1977 ttymode = buf->mode;
1978 if ( ttymode != TTY_RAW )
1979 LD->prompt.next = TRUE;
1980
1981 succeed;
1982 }
1983
1984 #endif /*HAVE_SGTTYB*/
1985 #endif /*O_HAVE_TERMIO*/
1986
1987
1988 /********************************
1989 * ENVIRONMENT CONTROL *
1990 *********************************/
1991
1992 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1993 Simple library to manipulate the OS environment. The modified
1994 environment will be passed to child processes and the can also be
1995 requested via getenv/2 from Prolog. Functions
1996
1997 int Setenv(name, value)
1998 char *name, *value;
1999
2000 Set the OS environment variable with name `name'. If it exists
2001 its value is changed, otherwise a new entry in the environment is
2002 created. The return value is a pointer to the old value, or NULL if
2003 the variable is new.
2004
2005 int Unsetenv(name)
2006 char *name;
2007
2008 Delete a variable from the environment. Return value is the old
2009 value, or NULL if the variable did not exist.
2010 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
2011
2012 size_t
getenv3(const char * name,char * buf,size_t len)2013 getenv3(const char *name, char *buf, size_t len)
2014 {
2015 #if O_XOS
2016 return _xos_getenv(name, buf, len);
2017 #else
2018 char *s = getenv(name);
2019 size_t l;
2020
2021 if ( s )
2022 { if ( (l=strlen(s)) < len )
2023 memcpy(buf, s, l+1);
2024 else if ( len > 0 )
2025 buf[0] = EOS; /* empty string if not fit */
2026
2027 return l;
2028 }
2029
2030 return (size_t)-1;
2031 #endif
2032 }
2033
2034
2035 char *
Getenv(const char * name,char * buf,size_t len)2036 Getenv(const char *name, char *buf, size_t len)
2037 { size_t l = getenv3(name, buf, len);
2038
2039 if ( l != (size_t)-1 && l < len )
2040 return buf;
2041
2042 return NULL;
2043 }
2044
2045
2046 #if defined(HAVE_PUTENV) || defined(HAVE_SETENV)
2047
2048 int
Setenv(char * name,char * value)2049 Setenv(char *name, char *value)
2050 {
2051 #ifdef HAVE_SETENV
2052 if ( setenv(name, value, TRUE) != 0 )
2053 return PL_error(NULL, 0, MSG_ERRNO, ERR_SYSCALL, "setenv");
2054 #else
2055 char *buf;
2056
2057 if ( *name == '\0' || strchr(name, '=') != NULL )
2058 { errno = EINVAL;
2059 return PL_error(NULL, 0, MSG_ERRNO, ERR_SYSCALL, "setenv");
2060 }
2061
2062 buf = alloca(strlen(name) + strlen(value) + 2);
2063
2064 if ( buf )
2065 { Ssprintf(buf, "%s=%s", name, value);
2066
2067 if ( putenv(store_string(buf)) < 0 )
2068 return PL_error(NULL, 0, MSG_ERRNO, ERR_SYSCALL, "setenv");
2069 } else
2070 return PL_error(NULL, 0, NULL, ERR_NOMEM);
2071 #endif
2072 succeed;
2073 }
2074
2075 int
Unsetenv(char * name)2076 Unsetenv(char *name)
2077 {
2078 #ifdef HAVE_UNSETENV
2079 #ifdef VOID_UNSETENV
2080 unsetenv(name);
2081 #else
2082 if ( unsetenv(name) < 0 )
2083 return PL_error(NULL, 0, MSG_ERRNO, ERR_SYSCALL, "unsetenv");
2084 #endif
2085
2086 succeed;
2087 #else
2088 if ( !getenv(name) )
2089 succeed;
2090
2091 return Setenv(name, "");
2092 #endif
2093 }
2094
2095 static void
initEnviron()2096 initEnviron()
2097 {
2098 }
2099
2100 #else /*HAVE_PUTENV*/
2101
2102 extern char **environ; /* Unix predefined environment */
2103
2104 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2105 Grow the environment array by one and return the (possibly moved) base
2106 pointer to the new environment.
2107 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
2108
2109 forwards char **growEnviron(char**, int);
2110 forwards char *matchName(char *, char *);
2111 forwards void setEntry(char **, char *, char *);
2112
2113 static char **
growEnviron(char ** e,int amount)2114 growEnviron(char **e, int amount)
2115 { static int filled;
2116 static int size = -1;
2117
2118 if ( amount == 0 ) /* reset after a dump */
2119 { size = -1;
2120 return e;
2121 }
2122
2123 if ( size < 0 )
2124 { char **env, **e1, **e2;
2125
2126 for(e1=e, filled=0; *e1; e1++, filled++)
2127 ;
2128 size = ROUND(filled+10+amount, 32);
2129 env = (char **)malloc(size * sizeof(char *));
2130 for ( e1=e, e2=env; *e1; *e2++ = *e1++ )
2131 ;
2132 *e2 = (char *) NULL;
2133 filled += amount;
2134
2135 return env;
2136 }
2137
2138 filled += amount;
2139 if ( filled + 1 > size )
2140 { char **env, **e1, **e2;
2141
2142 size += 32;
2143 env = (char **)realloc(e, size * sizeof(char *));
2144 for ( e1=e, e2=env; *e1; *e2++ = *e1++ )
2145 ;
2146 *e2 = (char *) NULL;
2147
2148 return env;
2149 }
2150
2151 return e;
2152 }
2153
2154
2155 static void
initEnviron(void)2156 initEnviron(void)
2157 { growEnviron(environ, 0);
2158 }
2159
2160
2161 static char *
matchName(const char * e,const char * name)2162 matchName(const char *e, const char *name)
2163 { while( *name && *e == *name )
2164 e++, name++;
2165
2166 if ( (*e == '=' || *e == EOS) && *name == EOS )
2167 return (*e == '=' ? e+1 : e);
2168
2169 return (char *) NULL;
2170 }
2171
2172
2173 static void
setEntry(char ** e,char * name,char * value)2174 setEntry(char **e, char *name, char *value)
2175 { int l = (int)strlen(name);
2176
2177 *e = (char *) malloc(l + strlen(value) + 2);
2178 strcpy(*e, name);
2179 e[0][l++] = '=';
2180 strcpy(&e[0][l], value);
2181 }
2182
2183
2184 char *
Setenv(char * name,char * value)2185 Setenv(char *name, char *value)
2186 { char **e;
2187 char *v;
2188 int n;
2189
2190 for(n=0, e=environ; *e; e++, n++)
2191 { if ( (v=matchName(*e, name)) != NULL )
2192 { if ( !streq(v, value) )
2193 setEntry(e, name, value);
2194 return v;
2195 }
2196 }
2197 environ = growEnviron(environ, 1);
2198 setEntry(&environ[n], name, value);
2199 environ[n+1] = (char *) NULL;
2200
2201 return (char *) NULL;
2202 }
2203
2204
2205 char *
Unsetenv(char * name)2206 Unsetenv(char *name)
2207 { char **e;
2208 char *v;
2209 int n;
2210
2211 for(n=0, e=environ; *e; e++, n++)
2212 { if ( (v=matchName(*e, name)) != NULL )
2213 { environ = growEnviron(environ, -1);
2214 e = &environ[n];
2215 do
2216 { e[0] = e[1];
2217 e++;
2218 } while(*e);
2219
2220 return v;
2221 }
2222 }
2223
2224 return (char *) NULL;
2225 }
2226
2227 #endif /*HAVE_PUTENV*/
2228
2229 /********************************
2230 * SYSTEM PROCESSES *
2231 *********************************/
2232
2233 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2234 int System(command)
2235 char *command;
2236
2237 Invoke a command on the operating system. The return value is the
2238 exit status of the command. Return value 0 implies succesful
2239 completion. If you are not running Unix your C-library might provide
2240 an alternative.
2241 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
2242
2243 #ifdef __unix__
2244 #define SPECIFIC_SYSTEM 1
2245
2246 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2247 According to the autoconf docs HAVE_SYS_WAIT_H is set if sys/wait.h is
2248 defined *and* is POSIX.1 compliant, which implies it uses int status
2249 argument to wait()
2250 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
2251
2252 #ifdef HAVE_SYS_WAIT_H
2253 #undef UNION_WAIT
2254 #include <sys/wait.h>
2255 #define wait_t int
2256
2257 #ifndef WEXITSTATUS
2258 # define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
2259 #endif
2260 #ifndef WIFEXITED
2261 # define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
2262 #endif
2263
2264 #else /*HAVE_SYS_WAIT_H*/
2265
2266 #ifdef UNION_WAIT /* Old BSD style wait */
2267 #include <sys/wait.h>
2268 #define wait_t union wait
2269
2270 #ifndef WEXITSTATUS
2271 #define WEXITSTATUS(s) ((s).w_status)
2272 #endif
2273 #ifndef WTERMSIG
2274 #define WTERMSIG(s) ((s).w_status)
2275 #endif
2276 #endif /*UNION_WAIT*/
2277
2278 #endif /*HAVE_SYS_WAIT_H*/
2279
2280
2281 int
System(char * cmd)2282 System(char *cmd)
2283 { GET_LD
2284 int pid;
2285 char *shell = "/bin/sh";
2286 int rval;
2287 void (*old_int)();
2288 void (*old_stop)();
2289
2290 if ( (pid = fork()) == -1 )
2291 { return PL_error("shell", 2, OsError(), ERR_SYSCALL, "fork");
2292 } else if ( pid == 0 ) /* The child */
2293 { Setenv("PROLOGCHILD", "yes");
2294 PL_cleanup_fork();
2295 execl(shell, BaseName(shell), "-c", cmd, (char *)0);
2296 fatalError("Failed to execute %s: %s", shell, OsError());
2297 fail;
2298 /*NOTREACHED*/
2299 } else
2300 { wait_t status; /* the parent */
2301 int n;
2302
2303 old_int = signal(SIGINT, SIG_IGN);
2304 #ifdef SIGTSTP
2305 old_stop = signal(SIGTSTP, SIG_DFL);
2306 #endif /* SIGTSTP */
2307
2308 for(;;)
2309 {
2310 #ifdef HAVE_WAITPID
2311 n = waitpid(pid, &status, 0);
2312 #else
2313 n = wait(&status);
2314 #endif
2315 if ( n == -1 && errno == EINTR )
2316 continue;
2317 if ( n != pid )
2318 continue;
2319 break;
2320 }
2321
2322 if ( n == -1 )
2323 { term_t tmp = PL_new_term_ref();
2324
2325 PL_put_atom_chars(tmp, cmd);
2326 PL_error("shell", 2, MSG_ERRNO, ERR_SHELL_FAILED, tmp);
2327
2328 rval = 1;
2329 } else if (WIFEXITED(status))
2330 { rval = WEXITSTATUS(status);
2331 #ifdef WIFSIGNALED
2332 } else if (WIFSIGNALED(status))
2333 { term_t tmp = PL_new_term_ref();
2334 int sig = WTERMSIG(status);
2335
2336 PL_put_atom_chars(tmp, cmd);
2337 PL_error("shell", 2, NULL, ERR_SHELL_SIGNALLED, tmp, sig);
2338 rval = 1;
2339 #endif
2340 } else
2341 { rval = 1; /* make gcc happy */
2342 fatalError("Unknown return code from wait(3)");
2343 /*NOTREACHED*/
2344 }
2345 }
2346
2347 signal(SIGINT, old_int); /* restore signal handlers */
2348 #ifdef SIGTSTP
2349 signal(SIGTSTP, old_stop);
2350 #endif /* SIGTSTP */
2351
2352 return rval;
2353 }
2354 #endif /* __unix__ */
2355
2356
2357 #ifdef HAVE_WINEXEC /* Windows 3.1 */
2358 #define SPECIFIC_SYSTEM 1
2359
2360 int
System(char * command)2361 System(char *command)
2362 { char *msg;
2363 int rval = WinExec(command, SW_SHOWNORMAL);
2364
2365 if ( rval < 32 )
2366 { switch( rval )
2367 { case 0: msg = "Not enough memory"; break;
2368 case 2: msg = "File not found"; break;
2369 case 3: msg = "No path"; break;
2370 case 5: msg = "Unknown error"; break;
2371 case 6: msg = "Lib requires separate data segment"; break;
2372 case 8: msg = "Not enough memory"; break;
2373 case 10: msg = "Incompatible Windows version"; break;
2374 case 11: msg = "Bad executable file"; break;
2375 case 12: msg = "Incompatible operating system"; break;
2376 case 13: msg = "MS-DOS 4.0 executable"; break;
2377 case 14: msg = "Unknown executable file type"; break;
2378 case 15: msg = "Real-mode application"; break;
2379 case 16: msg = "Cannot start multiple copies"; break;
2380 case 19: msg = "Executable is compressed"; break;
2381 case 20: msg = "Invalid DLL"; break;
2382 case 21: msg = "Application is 32-bits"; break;
2383 default: msg = "Unknown error";
2384 }
2385
2386 warning("Could not start %s: error %d (%s)",
2387 command, rval, msg);
2388 return 1;
2389 }
2390
2391 return 0;
2392 }
2393 #endif
2394
2395
2396 #ifdef __WINDOWS__
2397 #define SPECIFIC_SYSTEM 1
2398
2399 /* definition in pl-nt.c */
2400 #endif
2401
2402 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2403 Nothing special is needed. Just hope the C-library defines system().
2404 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
2405
2406 #ifndef SPECIFIC_SYSTEM
2407
2408 int
System(command)2409 System(command)
2410 char *command;
2411 { return system(command);
2412 }
2413
2414 #endif
2415
2416 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2417 [candidate]
2418
2419 exec(+Cmd, [+In, +Out, +Error], -Pid)
2420
2421 The streams may be one of standard stream, std, null stream, null, or
2422 pipe(S), where S is a pipe stream
2423
2424 Detach if none is std!
2425
2426 TBD: Sort out status. The above is SICStus 3. YAP uses `Status' for last
2427 argument (strange). SICStus 4 appears to drop this altogether.
2428 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
2429
2430
2431
2432
2433 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2434 char *Symbols(char *buf)
2435
2436 Return the path name of the executable of SWI-Prolog.
2437 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
2438
2439 #ifndef __WINDOWS__ /* Win32 version in pl-nt.c */
2440
2441 char *
findExecutable(const char * av0,char * buffer)2442 findExecutable(const char *av0, char *buffer)
2443 { char *file;
2444 char buf[MAXPATHLEN];
2445 char tmp[MAXPATHLEN];
2446
2447 if ( !av0 || !PrologPath(av0, buf, sizeof(buf)) )
2448 return NULL;
2449 file = Which(buf, tmp);
2450
2451 #if __unix__ || __APPLE__ /* argv[0] can be an #! script! */
2452 if ( file )
2453 { int n, fd;
2454 char buf[MAXPATHLEN];
2455
2456 /* Fails if mode is x-only, but */
2457 /* then it can't be a script! */
2458 if ( (fd = open(file, O_RDONLY)) < 0 )
2459 return strcpy(buffer, file);
2460
2461 if ( (n=read(fd, buf, sizeof(buf)-1)) > 0 )
2462 { close(fd);
2463
2464 buf[n] = EOS;
2465 if ( strncmp(buf, "#!", 2) == 0 )
2466 { char *s = &buf[2], *q;
2467 while(*s && isBlank(*s))
2468 s++;
2469 for(q=s; *q && !isBlank(*q); q++)
2470 ;
2471 *q = EOS;
2472
2473 return strcpy(buffer, s);
2474 }
2475 }
2476
2477 close(fd);
2478 }
2479 #endif /*__unix__*/
2480
2481 return strcpy(buffer, file ? file : buf);
2482 }
2483 #endif /*__WINDOWS__*/
2484
2485
2486 #if __unix__ || __APPLE__
2487 static char *
okToExec(const char * s)2488 okToExec(const char *s)
2489 { struct stat stbuff;
2490
2491 if (statfunc(s, &stbuff) == 0 && /* stat it */
2492 S_ISREG(stbuff.st_mode) && /* check for file */
2493 access(s, X_OK) == 0) /* can be executed? */
2494 return (char *)s;
2495 else
2496 return (char *) NULL;
2497 }
2498 #define PATHSEP ':'
2499 #endif /* __unix__ */
2500
2501 #if defined(OS2) || defined(__DOS__) || defined(__WINDOWS__)
2502 #define EXEC_EXTENSIONS { ".exe", ".com", ".bat", ".cmd", NULL }
2503 #define PATHSEP ';'
2504 #endif
2505
2506 #ifdef EXEC_EXTENSIONS
2507
2508 static char *
okToExec(const char * s)2509 okToExec(const char *s)
2510 { static char *extensions[] = EXEC_EXTENSIONS;
2511 static char **ext;
2512
2513 DEBUG(2, Sdprintf("Checking %s\n", s));
2514 for(ext = extensions; *ext; ext++)
2515 if ( stripostfix(s, *ext) )
2516 return ExistsFile(s) ? (char *)s : (char *) NULL;
2517
2518 for(ext = extensions; *ext; ext++)
2519 { static char path[MAXPATHLEN];
2520
2521 strcpy(path, s);
2522 strcat(path, *ext);
2523 if ( ExistsFile(path) )
2524 return path;
2525 }
2526
2527 return (char *) NULL;
2528 }
2529 #endif /*EXEC_EXTENSIONS*/
2530
2531 static char *
Which(const char * program,char * fullname)2532 Which(const char *program, char *fullname)
2533 { char *path, *dir;
2534 char *e;
2535
2536 if ( IsAbsolutePath(program) ||
2537 #if OS2 && EMX
2538 isDriveRelativePath(program) ||
2539 #endif /* OS2 */
2540 isRelativePath(program) ||
2541 strchr(program, '/') )
2542 { if ( (e = okToExec(program)) != NULL )
2543 { strcpy(fullname, e);
2544
2545 return fullname;
2546 }
2547
2548 return NULL;
2549 }
2550
2551 #if OS2 && EMX
2552 if ((e = okToExec(program)) != NULL)
2553 {
2554 getcwd(fullname, MAXPATHLEN);
2555 strcat(fullname, "/");
2556 strcat(fullname, e);
2557 return fullname;
2558 }
2559 #endif /* OS2 */
2560 if ((path = getenv("PATH") ) == 0)
2561 path = DEFAULT_PATH;
2562
2563 while(*path)
2564 { if ( *path == PATHSEP )
2565 { if ( (e = okToExec(program)) )
2566 return strcpy(fullname, e);
2567 else
2568 path++; /* fix by Ron Hess (hess@sco.com) */
2569 } else
2570 { char tmp[MAXPATHLEN];
2571
2572 for(dir = fullname; *path && *path != PATHSEP; *dir++ = *path++)
2573 ;
2574 if (*path)
2575 path++; /* skip : */
2576 if ((dir-fullname) + strlen(program)+2 > MAXPATHLEN)
2577 continue;
2578 *dir++ = '/';
2579 strcpy(dir, program);
2580 if ( (e = okToExec(OsPath(fullname, tmp))) )
2581 return strcpy(fullname, e);
2582 }
2583 }
2584
2585 return NULL;
2586 }
2587
2588
2589 /** int Pause(double time)
2590
2591 Suspend execution `time' seconds. Time is given as a floating point
2592 number, expressing the time to sleep in seconds. Just about every
2593 platform requires it own implementation. We provide them in the order of
2594 preference. The implementations differ on their granularity and whether
2595 or not they can be interrupted savely restarted. The recent POSIX
2596 nanosleep() is just about the only function that really works well:
2597 accurate, interruptable and restartable.
2598 */
2599
2600 #ifdef __WINDOWS__
2601 #define PAUSE_DONE 1 /* see pl-nt.c */
2602 #endif
2603
2604 #if !defined(PAUSE_DONE) && defined(HAVE_NANOSLEEP)
2605 #define PAUSE_DONE 1
2606
2607 int
Pause(double t)2608 Pause(double t)
2609 { struct timespec req;
2610 int rc;
2611
2612 if ( t < 0.0 )
2613 succeed;
2614
2615 req.tv_sec = (time_t) t;
2616 req.tv_nsec = (long)((t - floor(t)) * 1000000000);
2617
2618 for(;;)
2619 { rc = nanosleep(&req, &req);
2620 if ( rc == -1 && errno == EINTR )
2621 { if ( PL_handle_signals() < 0 )
2622 return FALSE;
2623 } else
2624 return TRUE;
2625 }
2626 }
2627
2628 #endif /*HAVE_NANOSLEEP*/
2629
2630
2631 #if !defined(PAUSE_DONE) && defined(HAVE_USLEEP)
2632 #define PAUSE_DONE 1
2633
2634 int
Pause(double t)2635 Pause(double t)
2636 { if ( t <= 0.0 )
2637 return TRUE;
2638
2639 usleep((unsigned long)(t * 1000000.0));
2640
2641 return TRUE;
2642 }
2643
2644 #endif /*HAVE_USLEEP*/
2645
2646
2647 #if !defined(PAUSE_DONE) && defined(HAVE_SELECT)
2648 #define PAUSE_DONE 1
2649
2650 int
Pause(double time)2651 Pause(double time)
2652 { struct timeval timeout;
2653
2654 if ( time <= 0.0 )
2655 return;
2656
2657 if ( time < 60.0 ) /* select() is expensive. Does it make sense */
2658 { timeout.tv_sec = (long)time;
2659 timeout.tv_usec = (long)(time * 1000000) % 1000000;
2660 select(32, NULL, NULL, NULL, &timeout);
2661
2662 return TRUE;
2663 } else
2664 { int rc;
2665 int left = (int)(time+0.5);
2666
2667 do
2668 { rc = sleep(left);
2669 if ( rc == -1 && errno == EINTR )
2670 { if ( PL_handle_signals() < 0 )
2671 return FALSE;
2672
2673 return TRUE;
2674 }
2675 left -= rc;
2676 } while ( rc != 0 );
2677 }
2678 }
2679
2680 #endif /*HAVE_SELECT*/
2681
2682 #if !defined(PAUSE_DONE) && defined(HAVE_DOSSLEEP)
2683 #define PAUSE_DONE 1
2684
2685 int /* a millisecond granualrity. */
Pause(double time)2686 Pause(double time) /* the EMX function sleep uses seconds */
2687 { if ( time <= 0.0 ) /* the select() trick does not work at all. */
2688 return TRUE;
2689
2690 DosSleep((ULONG)(time * 1000));
2691
2692 return TRUE;
2693 }
2694
2695 #endif /*HAVE_DOSSLEEP*/
2696
2697 #if !defined(PAUSE_DONE) && defined(HAVE_SLEEP)
2698 #define PAUSE_DONE 1
2699
2700 int
Pause(double t)2701 Pause(double t)
2702 { if ( t <= 0.5 )
2703 succeed;
2704
2705 sleep((int)(t + 0.5));
2706
2707 succeed;
2708 }
2709
2710 #endif /*HAVE_SLEEP*/
2711
2712 #if !defined(PAUSE_DONE) && defined(HAVE_DELAY)
2713 #define PAUSE_DONE 1
2714
2715 int
Pause(double t)2716 Pause(double t)
2717 { delay((int)(t * 1000));
2718
2719 return TRUE;
2720 }
2721
2722 #endif /*HAVE_DELAY*/
2723
2724 #ifndef PAUSE_DONE
2725 int
Pause(double t)2726 Pause(double t)
2727 { return notImplemented("sleep", 1);
2728 }
2729 #endif
2730
2731