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