1 /****************************************************************************
2 * *
3 * GNAT COMPILER COMPONENTS *
4 * *
5 * A D A I N T *
6 * *
7 * C Implementation File *
8 * *
9 * Copyright (C) 1992-2020, Free Software Foundation, Inc. *
10 * *
11 * GNAT is free software; you can redistribute it and/or modify it under *
12 * terms of the GNU General Public License as published by the Free Soft- *
13 * ware Foundation; either version 3, or (at your option) any later ver- *
14 * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
15 * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
16 * or FITNESS FOR A PARTICULAR PURPOSE. *
17 * *
18 * As a special exception under Section 7 of GPL version 3, you are granted *
19 * additional permissions described in the GCC Runtime Library Exception, *
20 * version 3.1, as published by the Free Software Foundation. *
21 * *
22 * You should have received a copy of the GNU General Public License and *
23 * a copy of the GCC Runtime Library Exception along with this program; *
24 * see the files COPYING3 and COPYING.RUNTIME respectively. If not, see *
25 * <http://www.gnu.org/licenses/>. *
26 * *
27 * GNAT was originally developed by the GNAT team at New York University. *
28 * Extensive contributions were provided by Ada Core Technologies Inc. *
29 * *
30 ****************************************************************************/
31
32 /* This file contains those routines named by Import pragmas in
33 packages in the GNAT hierarchy (especially GNAT.OS_Lib) and in
34 package Osint. Many of the subprograms in OS_Lib import standard
35 library calls directly. This file contains all other routines. */
36
37 /* Ensure access to errno is thread safe. */
38
39 #ifndef _REENTRANT
40 #define _REENTRANT
41 #endif
42
43 #ifndef _THREAD_SAFE
44 #define _THREAD_SAFE
45 #endif
46
47 /* Use 64 bit Large File API */
48 #if defined (__QNX__)
49 #define _LARGEFILE64_SOURCE 1
50 #elif !defined(_LARGEFILE_SOURCE)
51 #define _LARGEFILE_SOURCE
52 #endif
53 #define _FILE_OFFSET_BITS 64
54
55 #ifdef __vxworks
56
57 /* No need to redefine exit here. */
58 #undef exit
59
60 /* We want to use the POSIX variants of include files. */
61 #define POSIX
62 #include "vxWorks.h"
63 #include <sys/time.h>
64
65 #if defined (__mips_vxworks)
66 #include "cacheLib.h"
67 #endif /* __mips_vxworks */
68
69 /* If SMP, access vxCpuConfiguredGet */
70 #ifdef _WRS_CONFIG_SMP
71 #include <vxCpuLib.h>
72 #endif /* _WRS_CONFIG_SMP */
73
74 /* We need to know the VxWorks version because some file operations
75 (such as chmod) are only available on VxWorks 6. */
76 #include "version.h"
77
78 /* vwModNum.h and dosFsLib.h are needed for the VxWorks 6 rename workaround.
79 See below. */
80 #if (_WRS_VXWORKS_MAJOR == 6)
81 #include <vwModNum.h>
82 #include <dosFsLib.h>
83 #endif /* 6.x */
84 #endif /* VxWorks */
85
86 #if defined (__APPLE__)
87 #include <unistd.h>
88 #endif
89
90 #if defined (__hpux__)
91 #include <sys/param.h>
92 #include <sys/pstat.h>
93 #endif
94
95 #ifdef __PikeOS__
96 #define __BSD_VISIBLE 1
97 #endif
98
99 #ifdef __QNX__
100 #include <sys/syspage.h>
101 #endif
102
103 #ifdef IN_RTS
104
105 #ifdef STANDALONE
106 #include <errno.h>
107 #include <sys/types.h>
108 #include <sys/stat.h>
109 #include <unistd.h>
110 #include <stdlib.h>
111 #include <string.h>
112
113 /* for CPU_SET/CPU_ZERO */
114 #define _GNU_SOURCE
115 #define __USE_GNU
116
117 #include "runtime.h"
118
119 #else
120 #include "tconfig.h"
121 #include "tsystem.h"
122 #endif
123
124 #include <sys/stat.h>
125 #include <fcntl.h>
126 #include <time.h>
127
128 #if defined (__vxworks) || defined (__ANDROID__)
129 /* S_IREAD and S_IWRITE are not defined in VxWorks or Android */
130 #ifndef S_IREAD
131 #define S_IREAD (S_IRUSR | S_IRGRP | S_IROTH)
132 #endif
133
134 #ifndef S_IWRITE
135 #define S_IWRITE (S_IWUSR)
136 #endif
137 #endif
138
139 /* We don't have libiberty, so use malloc. */
140 #define xmalloc(S) malloc (S)
141 #define xrealloc(V,S) realloc (V,S)
142 #else
143 #include "config.h"
144 #include "system.h"
145 #include "version.h"
146 #endif
147
148 /* limits.h is needed for LLONG_MIN. */
149 #ifdef __cplusplus
150 #include <climits>
151 #else
152 #include <limits.h>
153 #endif
154
155 #ifdef __cplusplus
156 extern "C" {
157 #endif
158
159 #if defined (__DJGPP__)
160
161 /* For isalpha-like tests in the compiler, we're expected to resort to
162 safe-ctype.h/ISALPHA. This isn't available for the runtime library
163 build, so we fallback on ctype.h/isalpha there. */
164
165 #ifdef IN_RTS
166 #include <ctype.h>
167 #define ISALPHA isalpha
168 #endif
169
170 #elif defined (__MINGW32__) || defined (__CYGWIN__)
171
172 #include "mingw32.h"
173
174 /* Current code page and CCS encoding to use, set in initialize.c. */
175 UINT __gnat_current_codepage;
176 UINT __gnat_current_ccs_encoding;
177
178 #include <sys/utime.h>
179
180 /* For isalpha-like tests in the compiler, we're expected to resort to
181 safe-ctype.h/ISALPHA. This isn't available for the runtime library
182 build, so we fallback on ctype.h/isalpha there. */
183
184 #ifdef IN_RTS
185 #include <ctype.h>
186 #define ISALPHA isalpha
187 #endif
188
189 #elif defined (__Lynx__)
190
191 /* Lynx utime.h only defines the entities of interest to us if
192 defined (VMOS_DEV), so ... */
193 #define VMOS_DEV
194 #include <utime.h>
195 #undef VMOS_DEV
196
197 #else
198 #include <utime.h>
199 #endif
200
201 /* wait.h processing */
202 #ifdef __MINGW32__
203 # if OLD_MINGW
204 # include <sys/wait.h>
205 # endif
206 #elif defined (__vxworks) && defined (__RTP__)
207 # include <wait.h>
208 #elif defined (__Lynx__)
209 /* ??? We really need wait.h and it includes resource.h on Lynx. GCC
210 has a resource.h header as well, included instead of the lynx
211 version in our setup, causing lots of errors. We don't really need
212 the lynx contents of this file, so just workaround the issue by
213 preventing the inclusion of the GCC header from doing anything. */
214 # define GCC_RESOURCE_H
215 # include <sys/wait.h>
216 #elif defined (__PikeOS__)
217 /* No wait() or waitpid() calls available. */
218 #else
219 /* Default case. */
220 #include <sys/wait.h>
221 #endif
222
223 #if defined (__DJGPP__)
224 #include <process.h>
225 #include <signal.h>
226 #include <dir.h>
227 #include <utime.h>
228 #undef DIR_SEPARATOR
229 #define DIR_SEPARATOR '\\'
230
231 #elif defined (_WIN32)
232
233 #include <windows.h>
234 #include <accctrl.h>
235 #include <aclapi.h>
236 #include <tlhelp32.h>
237 #include <signal.h>
238 #undef DIR_SEPARATOR
239 #define DIR_SEPARATOR '\\'
240
241 #else
242 #include <utime.h>
243 #endif
244
245 #include "adaint.h"
246
247 int __gnat_in_child_after_fork = 0;
248
249 #if defined (__APPLE__) && defined (st_mtime)
250 #define st_atim st_atimespec
251 #define st_mtim st_mtimespec
252 #endif
253
254 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
255 defined in the current system. On DOS-like systems these flags control
256 whether the file is opened/created in text-translation mode (CR/LF in
257 external file mapped to LF in internal file), but in Unix-like systems,
258 no text translation is required, so these flags have no effect. */
259
260 #ifndef O_BINARY
261 #define O_BINARY 0
262 #endif
263
264 #ifndef O_TEXT
265 #define O_TEXT 0
266 #endif
267
268 #ifndef HOST_EXECUTABLE_SUFFIX
269 #define HOST_EXECUTABLE_SUFFIX ""
270 #endif
271
272 #ifndef HOST_OBJECT_SUFFIX
273 #define HOST_OBJECT_SUFFIX ".o"
274 #endif
275
276 #ifndef PATH_SEPARATOR
277 #define PATH_SEPARATOR ':'
278 #endif
279
280 #ifndef DIR_SEPARATOR
281 #define DIR_SEPARATOR '/'
282 #define IS_DIRECTORY_SEPARATOR(c) ((c) == DIR_SEPARATOR)
283 #else
284 #define IS_DIRECTORY_SEPARATOR(c) ((c) == '/' || (c) == DIR_SEPARATOR)
285 #endif
286
287 /* Check for cross-compilation. */
288 #if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
289 #define IS_CROSS 1
290 int __gnat_is_cross_compiler = 1;
291 #else
292 #undef IS_CROSS
293 int __gnat_is_cross_compiler = 0;
294 #endif
295
296 char __gnat_dir_separator = DIR_SEPARATOR;
297
298 char __gnat_path_separator = PATH_SEPARATOR;
299
300 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
301 the base filenames that libraries specified with -lsomelib options
302 may have. This is used by GNATMAKE to check whether an executable
303 is up-to-date or not. The syntax is
304
305 library_template ::= { pattern ; } pattern NUL
306 pattern ::= [ prefix ] * [ postfix ]
307
308 These should only specify names of static libraries as it makes
309 no sense to determine at link time if dynamic-link libraries are
310 up to date or not. Any libraries that are not found are supposed
311 to be up-to-date:
312
313 * if they are needed but not present, the link
314 will fail,
315
316 * otherwise they are libraries in the system paths and so
317 they are considered part of the system and not checked
318 for that reason.
319
320 ??? This should be part of a GNAT host-specific compiler
321 file instead of being included in all user applications
322 as well. This is only a temporary work-around for 3.11b. */
323
324 #ifndef GNAT_LIBRARY_TEMPLATE
325 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
326 #endif
327
328 const char *__gnat_library_template = GNAT_LIBRARY_TEMPLATE;
329
330 #if defined (__vxworks)
331 #define GNAT_MAX_PATH_LEN PATH_MAX
332
333 #else
334
335 #if defined (__MINGW32__)
336 #include "mingw32.h"
337
338 #if OLD_MINGW
339 #include <sys/param.h>
340 #endif
341
342 #else
343 #include <sys/param.h>
344 #endif
345
346 #ifdef MAXPATHLEN
347 #define GNAT_MAX_PATH_LEN MAXPATHLEN
348 #else
349 #define GNAT_MAX_PATH_LEN 256
350 #endif
351
352 #endif
353
354 /* Used for runtime check that Ada constant File_Attributes_Size is no
355 less than the actual size of struct file_attributes (see Osint
356 initialization). */
357 int __gnat_size_of_file_attributes = sizeof (struct file_attributes);
358
359 void __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr);
360
361 /* The __gnat_max_path_len variable is used to export the maximum
362 length of a path name to Ada code. max_path_len is also provided
363 for compatibility with older GNAT versions, please do not use
364 it. */
365
366 int __gnat_max_path_len = GNAT_MAX_PATH_LEN;
367 int max_path_len = GNAT_MAX_PATH_LEN;
368
369 /* Control whether we can use ACL on Windows. */
370
371 int __gnat_use_acl = 1;
372
373 /* The following macro HAVE_READDIR_R should be defined if the
374 system provides the routine readdir_r.
375 ... but we never define it anywhere??? */
376 #undef HAVE_READDIR_R
377
378 #define MAYBE_TO_PTR32(argv) argv
379
380 static const char ATTR_UNSET = 127;
381
382 /* Reset the file attributes as if no system call had been performed */
383
384 void
__gnat_reset_attributes(struct file_attributes * attr)385 __gnat_reset_attributes (struct file_attributes* attr)
386 {
387 attr->exists = ATTR_UNSET;
388 attr->error = EINVAL;
389
390 attr->writable = ATTR_UNSET;
391 attr->readable = ATTR_UNSET;
392 attr->executable = ATTR_UNSET;
393
394 attr->regular = ATTR_UNSET;
395 attr->symbolic_link = ATTR_UNSET;
396 attr->directory = ATTR_UNSET;
397
398 attr->timestamp = (OS_Time)-2;
399 attr->file_length = -1;
400 }
401
402 int
__gnat_error_attributes(struct file_attributes * attr)403 __gnat_error_attributes (struct file_attributes *attr) {
404 return attr->error;
405 }
406
407 OS_Time
__gnat_current_time(void)408 __gnat_current_time (void)
409 {
410 time_t res = time (NULL);
411 return (OS_Time) res;
412 }
413
414 /* Return the current local time as a string in the ISO 8601 format of
415 "YYYY-MM-DD HH:MM:SS.SS". The returned string is 22 + 1 (NULL) characters
416 long. */
417
418 void
__gnat_current_time_string(char * result)419 __gnat_current_time_string (char *result)
420 {
421 const char *format = "%Y-%m-%d %H:%M:%S";
422 /* Format string necessary to describe the ISO 8601 format */
423
424 const time_t t_val = time (NULL);
425
426 strftime (result, 22, format, localtime (&t_val));
427 /* Convert the local time into a string following the ISO format, copying
428 at most 22 characters into the result string. */
429
430 result [19] = '.';
431 result [20] = '0';
432 result [21] = '0';
433 /* The sub-seconds are manually set to zero since type time_t lacks the
434 precision necessary for nanoseconds. */
435 }
436
437 void
__gnat_to_gm_time(OS_Time * p_time,int * p_year,int * p_month,int * p_day,int * p_hours,int * p_mins,int * p_secs)438 __gnat_to_gm_time (OS_Time *p_time, int *p_year, int *p_month, int *p_day,
439 int *p_hours, int *p_mins, int *p_secs)
440 {
441 struct tm *res;
442 time_t time = (time_t) *p_time;
443
444 res = gmtime (&time);
445 if (res)
446 {
447 *p_year = res->tm_year;
448 *p_month = res->tm_mon;
449 *p_day = res->tm_mday;
450 *p_hours = res->tm_hour;
451 *p_mins = res->tm_min;
452 *p_secs = res->tm_sec;
453 }
454 else
455 *p_year = *p_month = *p_day = *p_hours = *p_mins = *p_secs = 0;
456 }
457
458 void
__gnat_to_os_time(OS_Time * p_time,int year,int month,int day,int hours,int mins,int secs)459 __gnat_to_os_time (OS_Time *p_time, int year, int month, int day,
460 int hours, int mins, int secs)
461 {
462 struct tm v;
463
464 v.tm_year = year;
465 v.tm_mon = month;
466 v.tm_mday = day;
467 v.tm_hour = hours;
468 v.tm_min = mins;
469 v.tm_sec = secs;
470 v.tm_isdst = -1;
471
472 /* returns -1 of failing, this is s-os_lib Invalid_Time */
473
474 *p_time = (OS_Time) mktime (&v);
475 }
476
477 /* Place the contents of the symbolic link named PATH in the buffer BUF,
478 which has size BUFSIZ. If PATH is a symbolic link, then return the number
479 of characters of its content in BUF. Otherwise, return -1.
480 For systems not supporting symbolic links, always return -1. */
481
482 int
__gnat_readlink(char * path ATTRIBUTE_UNUSED,char * buf ATTRIBUTE_UNUSED,size_t bufsiz ATTRIBUTE_UNUSED)483 __gnat_readlink (char *path ATTRIBUTE_UNUSED,
484 char *buf ATTRIBUTE_UNUSED,
485 size_t bufsiz ATTRIBUTE_UNUSED)
486 {
487 #if defined (_WIN32) \
488 || defined(__vxworks) || defined (__PikeOS__)
489 return -1;
490 #else
491 return readlink (path, buf, bufsiz);
492 #endif
493 }
494
495 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
496 If NEWPATH exists it will NOT be overwritten.
497 For systems not supporting symbolic links, always return -1. */
498
499 int
__gnat_symlink(char * oldpath ATTRIBUTE_UNUSED,char * newpath ATTRIBUTE_UNUSED)500 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED,
501 char *newpath ATTRIBUTE_UNUSED)
502 {
503 #if defined (_WIN32) \
504 || defined(__vxworks) || defined (__PikeOS__)
505 return -1;
506 #else
507 return symlink (oldpath, newpath);
508 #endif
509 }
510
511 /* Try to lock a file, return 1 if success. */
512
513 #if defined (__vxworks) \
514 || defined (_WIN32) || defined (__PikeOS__)
515
516 /* Version that does not use link. */
517
518 int
__gnat_try_lock(char * dir,char * file)519 __gnat_try_lock (char *dir, char *file)
520 {
521 int fd;
522 #ifdef __MINGW32__
523 TCHAR wfull_path[GNAT_MAX_PATH_LEN];
524 TCHAR wfile[GNAT_MAX_PATH_LEN];
525 TCHAR wdir[GNAT_MAX_PATH_LEN];
526
527 S2WSC (wdir, dir, GNAT_MAX_PATH_LEN);
528 S2WSC (wfile, file, GNAT_MAX_PATH_LEN);
529
530 /* ??? the code below crash on MingW64 for obscure reasons, a ticket
531 has been opened here:
532
533 https://sourceforge.net/p/mingw-w64/bugs/414/
534
535 As a workaround an equivalent set of code has been put in place below.
536
537 _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
538 */
539
540 _tcscpy (wfull_path, wdir);
541 _tcscat (wfull_path, L"\\");
542 _tcscat (wfull_path, wfile);
543
544 fd = _topen (wfull_path, O_CREAT | O_EXCL, 0600);
545 #else
546 char full_path[256];
547
548 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
549 fd = open (full_path, O_CREAT | O_EXCL, 0600);
550 #endif
551
552 if (fd < 0)
553 return 0;
554
555 close (fd);
556 return 1;
557 }
558
559 #else
560
561 /* Version using link(), more secure over NFS. */
562 /* See TN 6913-016 for discussion ??? */
563
564 int
__gnat_try_lock(char * dir,char * file)565 __gnat_try_lock (char *dir, char *file)
566 {
567 char full_path[256];
568 char temp_file[256];
569 GNAT_STRUCT_STAT stat_result;
570 int fd;
571
572 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
573 sprintf (temp_file, "%s%cTMP-%ld-%ld",
574 dir, DIR_SEPARATOR, (long)getpid(), (long)getppid ());
575
576 /* Create the temporary file and write the process number. */
577 fd = open (temp_file, O_CREAT | O_WRONLY, 0600);
578 if (fd < 0)
579 return 0;
580
581 close (fd);
582
583 /* Link it with the new file. */
584 link (temp_file, full_path);
585
586 /* Count the references on the old one. If we have a count of two, then
587 the link did succeed. Remove the temporary file before returning. */
588 __gnat_stat (temp_file, &stat_result);
589 unlink (temp_file);
590 return stat_result.st_nlink == 2;
591 }
592 #endif
593
594 /* Return the maximum file name length. */
595
596 int
__gnat_get_maximum_file_name_length(void)597 __gnat_get_maximum_file_name_length (void)
598 {
599 return -1;
600 }
601
602 /* Return nonzero if file names are case sensitive. */
603
604 static int file_names_case_sensitive_cache = -1;
605
606 int
__gnat_get_file_names_case_sensitive(void)607 __gnat_get_file_names_case_sensitive (void)
608 {
609 if (file_names_case_sensitive_cache == -1)
610 {
611 const char *sensitive = getenv ("GNAT_FILE_NAME_CASE_SENSITIVE");
612
613 if (sensitive != NULL
614 && (sensitive[0] == '0' || sensitive[0] == '1')
615 && sensitive[1] == '\0')
616 file_names_case_sensitive_cache = sensitive[0] - '0';
617 else
618 {
619 /* By default, we suppose filesystems aren't case sensitive on
620 Windows and Darwin (but they are on arm-darwin). */
621 #if defined (WINNT) || defined (__DJGPP__) \
622 || (defined (__APPLE__) && !(defined (__arm__) || defined (__arm64__)))
623 file_names_case_sensitive_cache = 0;
624 #else
625 file_names_case_sensitive_cache = 1;
626 #endif
627 }
628 }
629 return file_names_case_sensitive_cache;
630 }
631
632 /* Return nonzero if environment variables are case sensitive. */
633
634 int
__gnat_get_env_vars_case_sensitive(void)635 __gnat_get_env_vars_case_sensitive (void)
636 {
637 #if defined (WINNT) || defined (__DJGPP__)
638 return 0;
639 #else
640 return 1;
641 #endif
642 }
643
644 char
__gnat_get_default_identifier_character_set(void)645 __gnat_get_default_identifier_character_set (void)
646 {
647 return '1';
648 }
649
650 /* Return the current working directory. */
651
652 void
__gnat_get_current_dir(char * dir,int * length)653 __gnat_get_current_dir (char *dir, int *length)
654 {
655 #if defined (__MINGW32__)
656 TCHAR wdir[GNAT_MAX_PATH_LEN];
657
658 _tgetcwd (wdir, *length);
659
660 WS2SC (dir, wdir, GNAT_MAX_PATH_LEN);
661
662 #else
663 char* result = getcwd (dir, *length);
664 /* If the current directory does not exist, set length = 0
665 to indicate error. That can't happen on windows, where
666 you can't delete a directory if it is the current
667 directory of some process. */
668 if (!result)
669 {
670 *length = 0;
671 return;
672 }
673 #endif
674
675 *length = strlen (dir);
676
677 if (dir [*length - 1] != DIR_SEPARATOR)
678 {
679 dir [*length] = DIR_SEPARATOR;
680 ++(*length);
681 }
682 dir[*length] = '\0';
683 }
684
685 /* Return the suffix for object files. */
686
687 void
__gnat_get_object_suffix_ptr(int * len,const char ** value)688 __gnat_get_object_suffix_ptr (int *len, const char **value)
689 {
690 *value = HOST_OBJECT_SUFFIX;
691
692 if (*value == 0)
693 *len = 0;
694 else
695 *len = strlen (*value);
696
697 return;
698 }
699
700 /* Return the suffix for executable files. */
701
702 void
__gnat_get_executable_suffix_ptr(int * len,const char ** value)703 __gnat_get_executable_suffix_ptr (int *len, const char **value)
704 {
705 *value = HOST_EXECUTABLE_SUFFIX;
706
707 if (!*value)
708 *len = 0;
709 else
710 *len = strlen (*value);
711
712 return;
713 }
714
715 /* Return the suffix for debuggable files. Usually this is the same as the
716 executable extension. */
717
718 void
__gnat_get_debuggable_suffix_ptr(int * len,const char ** value)719 __gnat_get_debuggable_suffix_ptr (int *len, const char **value)
720 {
721 *value = HOST_EXECUTABLE_SUFFIX;
722
723 if (*value == 0)
724 *len = 0;
725 else
726 *len = strlen (*value);
727
728 return;
729 }
730
731 /* Returns the OS filename and corresponding encoding. */
732
733 void
__gnat_os_filename(char * filename ATTRIBUTE_UNUSED,char * w_filename ATTRIBUTE_UNUSED,char * os_name,int * o_length,char * encoding ATTRIBUTE_UNUSED,int * e_length)734 __gnat_os_filename (char *filename ATTRIBUTE_UNUSED,
735 char *w_filename ATTRIBUTE_UNUSED,
736 char *os_name, int *o_length,
737 char *encoding ATTRIBUTE_UNUSED, int *e_length)
738 {
739 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
740 WS2SC (os_name, (TCHAR *)w_filename, (DWORD)*o_length);
741 *o_length = strlen (os_name);
742 strcpy (encoding, "encoding=utf8");
743 *e_length = strlen (encoding);
744 #else
745 strcpy (os_name, filename);
746 *o_length = strlen (filename);
747 *e_length = 0;
748 #endif
749 }
750
751 /* Delete a file. */
752
753 int
__gnat_unlink(char * path)754 __gnat_unlink (char *path)
755 {
756 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
757 {
758 TCHAR wpath[GNAT_MAX_PATH_LEN];
759
760 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
761 return _tunlink (wpath);
762 }
763 #else
764 return unlink (path);
765 #endif
766 }
767
768 /* Rename a file. */
769
770 int
__gnat_rename(char * from,char * to)771 __gnat_rename (char *from, char *to)
772 {
773 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
774 {
775 TCHAR wfrom[GNAT_MAX_PATH_LEN], wto[GNAT_MAX_PATH_LEN];
776
777 S2WSC (wfrom, from, GNAT_MAX_PATH_LEN);
778 S2WSC (wto, to, GNAT_MAX_PATH_LEN);
779 return _trename (wfrom, wto);
780 }
781 #elif defined (__vxworks) && (_WRS_VXWORKS_MAJOR == 6)
782 {
783 /* When used on a dos filesystem under VxWorks 6.9 rename will trigger a
784 S_dosFsLib_FILE_NOT_FOUND errno when the file is not found. Let's map
785 that to ENOENT so Ada.Directory.Rename can detect that and raise the
786 Name_Error exception. */
787 int ret = rename (from, to);
788
789 if (ret && (errno == S_dosFsLib_FILE_NOT_FOUND))
790 {
791 errno = ENOENT;
792 }
793 return ret;
794 }
795 #else
796 return rename (from, to);
797 #endif
798 }
799
800 /* Changing directory. */
801
802 int
__gnat_chdir(char * path)803 __gnat_chdir (char *path)
804 {
805 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
806 {
807 TCHAR wpath[GNAT_MAX_PATH_LEN];
808
809 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
810 return _tchdir (wpath);
811 }
812 #else
813 return chdir (path);
814 #endif
815 }
816
817 /* Removing a directory. */
818
819 int
__gnat_rmdir(char * path)820 __gnat_rmdir (char *path)
821 {
822 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
823 {
824 TCHAR wpath[GNAT_MAX_PATH_LEN];
825
826 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
827 return _trmdir (wpath);
828 }
829 #elif defined (VTHREADS)
830 /* rmdir not available */
831 return -1;
832 #else
833 return rmdir (path);
834 #endif
835 }
836
837 #if defined (_WIN32) || defined (__linux__) || defined (__sun__) \
838 || defined (__FreeBSD__) || defined(__DragonFly__) || defined (__QNX__)
839 #define HAS_TARGET_WCHAR_T
840 #endif
841
842 #ifdef HAS_TARGET_WCHAR_T
843 #include <wchar.h>
844 #endif
845
846 int
__gnat_fputwc(int c,FILE * stream)847 __gnat_fputwc(int c, FILE *stream)
848 {
849 #ifdef HAS_TARGET_WCHAR_T
850 return fputwc ((wchar_t)c, stream);
851 #else
852 return fputc (c, stream);
853 #endif
854 }
855
856 FILE *
__gnat_fopen(char * path,char * mode,int encoding ATTRIBUTE_UNUSED)857 __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED)
858 {
859 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
860 TCHAR wpath[GNAT_MAX_PATH_LEN];
861 TCHAR wmode[10];
862
863 S2WS (wmode, mode, 10);
864
865 if (encoding == Encoding_Unspecified)
866 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
867 else if (encoding == Encoding_UTF8)
868 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
869 else
870 S2WS (wpath, path, GNAT_MAX_PATH_LEN);
871
872 return _tfopen (wpath, wmode);
873
874 #else
875 return GNAT_FOPEN (path, mode);
876 #endif
877 }
878
879 FILE *
__gnat_freopen(char * path,char * mode,FILE * stream,int encoding ATTRIBUTE_UNUSED)880 __gnat_freopen (char *path,
881 char *mode,
882 FILE *stream,
883 int encoding ATTRIBUTE_UNUSED)
884 {
885 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
886 TCHAR wpath[GNAT_MAX_PATH_LEN];
887 TCHAR wmode[10];
888
889 S2WS (wmode, mode, 10);
890
891 if (encoding == Encoding_Unspecified)
892 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
893 else if (encoding == Encoding_UTF8)
894 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
895 else
896 S2WS (wpath, path, GNAT_MAX_PATH_LEN);
897
898 return _tfreopen (wpath, wmode, stream);
899 #else
900 return freopen (path, mode, stream);
901 #endif
902 }
903
904 int
__gnat_open_read(char * path,int fmode)905 __gnat_open_read (char *path, int fmode)
906 {
907 int fd;
908 int o_fmode = O_BINARY;
909
910 if (fmode)
911 o_fmode = O_TEXT;
912
913 #if defined (__vxworks)
914 fd = open (path, O_RDONLY | o_fmode, 0444);
915 #elif defined (__MINGW32__)
916 {
917 TCHAR wpath[GNAT_MAX_PATH_LEN];
918
919 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
920 fd = _topen (wpath, O_RDONLY | o_fmode, 0444);
921 }
922 #else
923 fd = GNAT_OPEN (path, O_RDONLY | o_fmode);
924 #endif
925
926 return fd < 0 ? -1 : fd;
927 }
928
929 #if defined (__MINGW32__)
930 #define PERM (S_IREAD | S_IWRITE)
931 #else
932 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
933 #endif
934
935 int
__gnat_open_rw(char * path,int fmode)936 __gnat_open_rw (char *path, int fmode)
937 {
938 int fd;
939 int o_fmode = O_BINARY;
940
941 if (fmode)
942 o_fmode = O_TEXT;
943
944 #if defined (__MINGW32__)
945 {
946 TCHAR wpath[GNAT_MAX_PATH_LEN];
947
948 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
949 fd = _topen (wpath, O_RDWR | o_fmode, PERM);
950 }
951 #else
952 fd = GNAT_OPEN (path, O_RDWR | o_fmode, PERM);
953 #endif
954
955 return fd < 0 ? -1 : fd;
956 }
957
958 int
__gnat_open_create(char * path,int fmode)959 __gnat_open_create (char *path, int fmode)
960 {
961 int fd;
962 int o_fmode = O_BINARY;
963
964 if (fmode)
965 o_fmode = O_TEXT;
966
967 #if defined (__MINGW32__)
968 {
969 TCHAR wpath[GNAT_MAX_PATH_LEN];
970
971 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
972 fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
973 }
974 #else
975 fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
976 #endif
977
978 return fd < 0 ? -1 : fd;
979 }
980
981 int
__gnat_create_output_file(char * path)982 __gnat_create_output_file (char *path)
983 {
984 int fd;
985 #if defined (__MINGW32__)
986 {
987 TCHAR wpath[GNAT_MAX_PATH_LEN];
988
989 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
990 fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
991 }
992 #else
993 fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
994 #endif
995
996 return fd < 0 ? -1 : fd;
997 }
998
999 int
__gnat_create_output_file_new(char * path)1000 __gnat_create_output_file_new (char *path)
1001 {
1002 int fd;
1003 #if defined (__MINGW32__)
1004 {
1005 TCHAR wpath[GNAT_MAX_PATH_LEN];
1006
1007 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
1008 fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
1009 }
1010 #else
1011 fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
1012 #endif
1013
1014 return fd < 0 ? -1 : fd;
1015 }
1016
1017 int
__gnat_open_append(char * path,int fmode)1018 __gnat_open_append (char *path, int fmode)
1019 {
1020 int fd;
1021 int o_fmode = O_BINARY;
1022
1023 if (fmode)
1024 o_fmode = O_TEXT;
1025
1026 #if defined (__MINGW32__)
1027 {
1028 TCHAR wpath[GNAT_MAX_PATH_LEN];
1029
1030 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
1031 fd = _topen (wpath, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
1032 }
1033 #else
1034 fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
1035 #endif
1036
1037 return fd < 0 ? -1 : fd;
1038 }
1039
1040 /* Open a new file. Return error (-1) if the file already exists. */
1041
1042 int
__gnat_open_new(char * path,int fmode)1043 __gnat_open_new (char *path, int fmode)
1044 {
1045 int fd;
1046 int o_fmode = O_BINARY;
1047
1048 if (fmode)
1049 o_fmode = O_TEXT;
1050
1051 #if defined (__MINGW32__)
1052 {
1053 TCHAR wpath[GNAT_MAX_PATH_LEN];
1054
1055 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
1056 fd = _topen (wpath, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
1057 }
1058 #else
1059 fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
1060 #endif
1061
1062 return fd < 0 ? -1 : fd;
1063 }
1064
1065 /* Open a new temp file. Return error (-1) if the file already exists. */
1066
1067 int
__gnat_open_new_temp(char * path,int fmode)1068 __gnat_open_new_temp (char *path, int fmode)
1069 {
1070 int fd;
1071 int o_fmode = O_BINARY;
1072
1073 strcpy (path, "GNAT-XXXXXX");
1074
1075 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
1076 || defined (__linux__) || defined (__GLIBC__) || defined (__ANDROID__) \
1077 || defined (__DragonFly__) || defined (__QNX__)) && !defined (__vxworks)
1078 return mkstemp (path);
1079 #elif defined (__Lynx__)
1080 mktemp (path);
1081 #else
1082 if (mktemp (path) == NULL)
1083 return -1;
1084 #endif
1085
1086 if (fmode)
1087 o_fmode = O_TEXT;
1088
1089 fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
1090 return fd < 0 ? -1 : fd;
1091 }
1092
1093 int
__gnat_open(char * path,int fmode)1094 __gnat_open (char *path, int fmode)
1095 {
1096 int fd;
1097
1098 #if defined (__MINGW32__)
1099 {
1100 TCHAR wpath[GNAT_MAX_PATH_LEN];
1101
1102 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
1103 fd = _topen (wpath, fmode, PERM);
1104 }
1105 #else
1106 fd = GNAT_OPEN (path, fmode, PERM);
1107 #endif
1108
1109 return fd < 0 ? -1 : fd;
1110 }
1111
1112 /****************************************************************
1113 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
1114 ** as possible from it, storing the result in a cache for later reuse
1115 ****************************************************************/
1116
1117 void
__gnat_stat_to_attr(int fd,char * name,struct file_attributes * attr)1118 __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr)
1119 {
1120 GNAT_STRUCT_STAT statbuf;
1121 int ret, error;
1122
1123 if (fd != -1) {
1124 /* GNAT_FSTAT returns -1 and sets errno for failure */
1125 ret = GNAT_FSTAT (fd, &statbuf);
1126 error = ret ? errno : 0;
1127
1128 } else {
1129 /* __gnat_stat returns errno value directly */
1130 error = __gnat_stat (name, &statbuf);
1131 ret = error ? -1 : 0;
1132 }
1133
1134 /*
1135 * A missing file is reported as an attr structure with error == 0 and
1136 * exists == 0.
1137 */
1138
1139 if (error == 0 || error == ENOENT)
1140 attr->error = 0;
1141 else
1142 attr->error = error;
1143
1144 attr->regular = (!ret && S_ISREG (statbuf.st_mode));
1145 attr->directory = (!ret && S_ISDIR (statbuf.st_mode));
1146
1147 if (!attr->regular)
1148 attr->file_length = 0;
1149 else
1150 /* st_size may be 32 bits, or 64 bits which is converted to long. We
1151 don't return a useful value for files larger than 2 gigabytes in
1152 either case. */
1153 attr->file_length = statbuf.st_size; /* all systems */
1154
1155 attr->exists = !ret;
1156
1157 #if !defined (_WIN32)
1158 /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
1159 attr->readable = (!ret && (statbuf.st_mode & S_IRUSR));
1160 attr->writable = (!ret && (statbuf.st_mode & S_IWUSR));
1161 attr->executable = (!ret && (statbuf.st_mode & S_IXUSR));
1162 #endif
1163
1164 if (ret != 0) {
1165 attr->timestamp = (OS_Time)-1;
1166 } else {
1167 attr->timestamp = (OS_Time)statbuf.st_mtime;
1168 }
1169 }
1170
1171 /****************************************************************
1172 ** Return the number of bytes in the specified file
1173 ****************************************************************/
1174
1175 __int64
__gnat_file_length_attr(int fd,char * name,struct file_attributes * attr)1176 __gnat_file_length_attr (int fd, char* name, struct file_attributes* attr)
1177 {
1178 if (attr->file_length == -1) {
1179 __gnat_stat_to_attr (fd, name, attr);
1180 }
1181
1182 return attr->file_length;
1183 }
1184
1185 __int64
__gnat_file_length(int fd)1186 __gnat_file_length (int fd)
1187 {
1188 struct file_attributes attr;
1189 __gnat_reset_attributes (&attr);
1190 return __gnat_file_length_attr (fd, NULL, &attr);
1191 }
1192
1193 long
__gnat_file_length_long(int fd)1194 __gnat_file_length_long (int fd)
1195 {
1196 struct file_attributes attr;
1197 __gnat_reset_attributes (&attr);
1198 return (long)__gnat_file_length_attr (fd, NULL, &attr);
1199 }
1200
1201 __int64
__gnat_named_file_length(char * name)1202 __gnat_named_file_length (char *name)
1203 {
1204 struct file_attributes attr;
1205 __gnat_reset_attributes (&attr);
1206 return __gnat_file_length_attr (-1, name, &attr);
1207 }
1208
1209 /* Create a temporary filename and put it in string pointed to by
1210 TMP_FILENAME. */
1211
1212 void
__gnat_tmp_name(char * tmp_filename)1213 __gnat_tmp_name (char *tmp_filename)
1214 {
1215 #if defined (__MINGW32__)
1216 {
1217 char *pname;
1218 char prefix[25];
1219
1220 /* tempnam tries to create a temporary file in directory pointed to by
1221 TMP environment variable, in c:\temp if TMP is not set, and in
1222 directory specified by P_tmpdir in stdio.h if c:\temp does not
1223 exist. The filename will be created with the prefix "gnat-". */
1224
1225 sprintf (prefix, "gnat-%d-", (int)getpid());
1226 pname = (char *) _tempnam ("c:\\temp", prefix);
1227
1228 /* if pname is NULL, the file was not created properly, the disk is full
1229 or there is no more free temporary files */
1230
1231 if (pname == NULL)
1232 *tmp_filename = '\0';
1233
1234 /* If pname start with a back slash and not path information it means that
1235 the filename is valid for the current working directory. */
1236
1237 else if (pname[0] == '\\')
1238 {
1239 strcpy (tmp_filename, ".\\");
1240 strcat (tmp_filename, pname+1);
1241 }
1242 else
1243 strcpy (tmp_filename, pname);
1244
1245 free (pname);
1246 }
1247
1248 #elif defined (__linux__) || defined (__FreeBSD__) || defined (__NetBSD__) \
1249 || defined (__OpenBSD__) || defined (__GLIBC__) || defined (__ANDROID__) \
1250 || defined (__DragonFly__) || defined (__QNX__)
1251 #define MAX_SAFE_PATH 1000
1252 char *tmpdir = getenv ("TMPDIR");
1253
1254 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1255 a buffer overflow. */
1256 if (tmpdir == NULL || strlen (tmpdir) > MAX_SAFE_PATH)
1257 #ifdef __ANDROID__
1258 strcpy (tmp_filename, "/cache/gnat-XXXXXX");
1259 #else
1260 strcpy (tmp_filename, "/tmp/gnat-XXXXXX");
1261 #endif
1262 else
1263 sprintf (tmp_filename, "%s/gnat-XXXXXX", tmpdir);
1264
1265 close (mkstemp(tmp_filename));
1266 #elif defined (__vxworks) && !defined (VTHREADS)
1267 int index;
1268 char *pos;
1269 char *savepos;
1270 static ushort_t seed = 0; /* used to generate unique name */
1271
1272 /* Generate a unique name. */
1273 strcpy (tmp_filename, "tmp");
1274
1275 index = 5;
1276 savepos = pos = tmp_filename + strlen (tmp_filename) + index;
1277 *pos = '\0';
1278
1279 while (1)
1280 {
1281 FILE *f;
1282 ushort_t t;
1283
1284 /* Fill up the name buffer from the last position. */
1285 seed++;
1286 for (t = seed; --index >= 0; t >>= 3)
1287 *--pos = '0' + (t & 07);
1288
1289 /* Check to see if its unique, if not bump the seed and try again. */
1290 f = fopen (tmp_filename, "r");
1291 if (f == NULL)
1292 break;
1293 fclose (f);
1294 pos = savepos;
1295 index = 5;
1296 }
1297 #else
1298 tmpnam (tmp_filename);
1299 #endif
1300 }
1301
1302 /* Open directory and returns a DIR pointer. */
1303
__gnat_opendir(char * name)1304 DIR* __gnat_opendir (char *name)
1305 {
1306 #if defined (__MINGW32__)
1307 TCHAR wname[GNAT_MAX_PATH_LEN];
1308
1309 S2WSC (wname, name, GNAT_MAX_PATH_LEN);
1310 return (DIR*)_topendir (wname);
1311
1312 #else
1313 return opendir (name);
1314 #endif
1315 }
1316
1317 /* Read the next entry in a directory. The returned string points somewhere
1318 in the buffer. */
1319
1320 #if defined (__sun__)
1321 /* For Solaris, be sure to use the 64-bit version, otherwise NFS reads may
1322 fail with EOVERFLOW if the server uses 64-bit cookies. */
1323 #define dirent dirent64
1324 #define readdir readdir64
1325 #endif
1326
1327 char *
__gnat_readdir(DIR * dirp,char * buffer,int * len)1328 __gnat_readdir (DIR *dirp, char *buffer, int *len)
1329 {
1330 #if defined (__MINGW32__)
1331 struct _tdirent *dirent = _treaddir ((_TDIR*)dirp);
1332
1333 if (dirent != NULL)
1334 {
1335 WS2SC (buffer, dirent->d_name, GNAT_MAX_PATH_LEN);
1336 *len = strlen (buffer);
1337
1338 return buffer;
1339 }
1340 else
1341 return NULL;
1342
1343 #elif defined (HAVE_READDIR_R)
1344 /* If possible, try to use the thread-safe version. */
1345 if (readdir_r (dirp, buffer) != NULL)
1346 {
1347 *len = strlen (((struct dirent*) buffer)->d_name);
1348 return ((struct dirent*) buffer)->d_name;
1349 }
1350 else
1351 return NULL;
1352
1353 #else
1354 struct dirent *dirent = (struct dirent *) readdir (dirp);
1355
1356 if (dirent != NULL)
1357 {
1358 strcpy (buffer, dirent->d_name);
1359 *len = strlen (buffer);
1360 return buffer;
1361 }
1362 else
1363 return NULL;
1364
1365 #endif
1366 }
1367
1368 /* Close a directory entry. */
1369
__gnat_closedir(DIR * dirp)1370 int __gnat_closedir (DIR *dirp)
1371 {
1372 #if defined (__MINGW32__)
1373 return _tclosedir ((_TDIR*)dirp);
1374
1375 #else
1376 return closedir (dirp);
1377 #endif
1378 }
1379
1380 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1381
1382 int
__gnat_readdir_is_thread_safe(void)1383 __gnat_readdir_is_thread_safe (void)
1384 {
1385 #ifdef HAVE_READDIR_R
1386 return 1;
1387 #else
1388 return 0;
1389 #endif
1390 }
1391
1392 #if defined (_WIN32)
1393 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1394 static const unsigned long long w32_epoch_offset = 11644473600ULL;
1395
1396 /* Returns the file modification timestamp using Win32 routines which are
1397 immune against daylight saving time change. It is in fact not possible to
1398 use fstat for this purpose as the DST modify the st_mtime field of the
1399 stat structure. */
1400
1401 static time_t
win32_filetime(HANDLE h)1402 win32_filetime (HANDLE h)
1403 {
1404 union
1405 {
1406 FILETIME ft_time;
1407 unsigned long long ull_time;
1408 } t_write;
1409
1410 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1411 since <Jan 1st 1601>. This function must return the number of seconds
1412 since <Jan 1st 1970>. */
1413
1414 if (GetFileTime (h, NULL, NULL, &t_write.ft_time))
1415 return (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
1416 return (time_t) 0;
1417 }
1418
1419 /* As above but starting from a FILETIME. */
1420 static void
f2t(const FILETIME * ft,__time64_t * t)1421 f2t (const FILETIME *ft, __time64_t *t)
1422 {
1423 union
1424 {
1425 FILETIME ft_time;
1426 unsigned long long ull_time;
1427 } t_write;
1428
1429 t_write.ft_time = *ft;
1430 *t = (__time64_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
1431 }
1432 #endif
1433
1434 /* Return a GNAT time stamp given a file name. */
1435
1436 OS_Time
__gnat_file_time_name_attr(char * name,struct file_attributes * attr)1437 __gnat_file_time_name_attr (char* name, struct file_attributes* attr)
1438 {
1439 if (attr->timestamp == (OS_Time)-2) {
1440 #if defined (_WIN32)
1441 BOOL res;
1442 WIN32_FILE_ATTRIBUTE_DATA fad;
1443 __time64_t ret = -1;
1444 TCHAR wname[GNAT_MAX_PATH_LEN];
1445 S2WSC (wname, name, GNAT_MAX_PATH_LEN);
1446
1447 if ((res = GetFileAttributesEx (wname, GetFileExInfoStandard, &fad)))
1448 f2t (&fad.ftLastWriteTime, &ret);
1449 attr->timestamp = (OS_Time) ret;
1450 #else
1451 __gnat_stat_to_attr (-1, name, attr);
1452 #endif
1453 }
1454 return attr->timestamp;
1455 }
1456
1457 OS_Time
__gnat_file_time_name(char * name)1458 __gnat_file_time_name (char *name)
1459 {
1460 struct file_attributes attr;
1461 __gnat_reset_attributes (&attr);
1462 return __gnat_file_time_name_attr (name, &attr);
1463 }
1464
1465 /* Return a GNAT time stamp given a file descriptor. */
1466
1467 OS_Time
__gnat_file_time_fd_attr(int fd,struct file_attributes * attr)1468 __gnat_file_time_fd_attr (int fd, struct file_attributes* attr)
1469 {
1470 if (attr->timestamp == (OS_Time)-2) {
1471 #if defined (_WIN32)
1472 HANDLE h = (HANDLE) _get_osfhandle (fd);
1473 time_t ret = win32_filetime (h);
1474 attr->timestamp = (OS_Time) ret;
1475
1476 #else
1477 __gnat_stat_to_attr (fd, NULL, attr);
1478 #endif
1479 }
1480
1481 return attr->timestamp;
1482 }
1483
1484 OS_Time
__gnat_file_time_fd(int fd)1485 __gnat_file_time_fd (int fd)
1486 {
1487 struct file_attributes attr;
1488 __gnat_reset_attributes (&attr);
1489 return __gnat_file_time_fd_attr (fd, &attr);
1490 }
1491
__gnat_file_time(char * name)1492 extern long long __gnat_file_time(char* name)
1493 {
1494 long long result;
1495
1496 if (name == NULL) {
1497 return LLONG_MIN;
1498 }
1499 /* Number of seconds between <Jan 1st 1970> and <Jan 1st 2150>. */
1500 static const long long ada_epoch_offset = (136 * 365 + 44 * 366) * 86400LL;
1501 #if defined(_WIN32)
1502
1503 /* Number of 100 nanoseconds between <Jan 1st 1601> and <Jan 1st 2150>. */
1504 static const long long w32_epoch_offset =
1505 (11644473600LL + ada_epoch_offset) * 1E7;
1506
1507 WIN32_FILE_ATTRIBUTE_DATA fad;
1508 union
1509 {
1510 FILETIME ft_time;
1511 long long ll_time;
1512 } t_write;
1513
1514 if (!GetFileAttributesExA(name, GetFileExInfoStandard, &fad)) {
1515 return LLONG_MIN;
1516 }
1517
1518 t_write.ft_time = fad.ftLastWriteTime;
1519
1520 #if defined(__GNUG__) && __GNUG__ <= 4
1521 result = (t_write.ll_time - w32_epoch_offset) * 100;
1522 #else
1523 /* Next code similar to (t_write.ll_time - w32_epoch_offset) * 100
1524 but on overflow returns LLONG_MIN value. */
1525
1526 if (__builtin_ssubll_overflow(t_write.ll_time, w32_epoch_offset, &result)) {
1527 return LLONG_MIN;
1528 }
1529
1530 if (__builtin_smulll_overflow(result, 100, &result)) {
1531 return LLONG_MIN;
1532 }
1533 #endif
1534
1535 #else
1536
1537 struct stat sb;
1538 if (stat(name, &sb) != 0) {
1539 return LLONG_MIN;
1540 }
1541
1542 #if defined(__GNUG__) && __GNUG__ <= 4
1543 result = (sb.st_mtime - ada_epoch_offset) * 1E9;
1544 #if defined(st_mtime)
1545 result += sb.st_mtim.tv_nsec;
1546 #endif
1547 #else
1548 /* Next code similar to
1549 (sb.st_mtime - ada_epoch_offset) * 1E9 + sb.st_mtim.tv_nsec
1550 but on overflow returns LLONG_MIN value. */
1551
1552 if (__builtin_ssubll_overflow(sb.st_mtime, ada_epoch_offset, &result)) {
1553 return LLONG_MIN;
1554 }
1555
1556 if (__builtin_smulll_overflow(result, 1E9, &result)) {
1557 return LLONG_MIN;
1558 }
1559
1560 #if defined(st_mtime)
1561 if (__builtin_saddll_overflow(result, sb.st_mtim.tv_nsec, &result)) {
1562 return LLONG_MIN;
1563 }
1564 #endif
1565 #endif
1566 #endif
1567 return result;
1568 }
1569
1570 /* Set the file time stamp. */
1571
1572 void
__gnat_set_file_time_name(char * name,time_t time_stamp)1573 __gnat_set_file_time_name (char *name, time_t time_stamp)
1574 {
1575 #if defined (__vxworks)
1576
1577 /* Code to implement __gnat_set_file_time_name for these systems. */
1578
1579 #elif defined (_WIN32)
1580 union
1581 {
1582 FILETIME ft_time;
1583 unsigned long long ull_time;
1584 } t_write;
1585 TCHAR wname[GNAT_MAX_PATH_LEN];
1586
1587 S2WSC (wname, name, GNAT_MAX_PATH_LEN);
1588
1589 HANDLE h = CreateFile
1590 (wname, GENERIC_WRITE, FILE_SHARE_WRITE, NULL,
1591 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS,
1592 NULL);
1593 if (h == INVALID_HANDLE_VALUE)
1594 return;
1595 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1596 t_write.ull_time = ((unsigned long long)time_stamp + w32_epoch_offset);
1597 /* Convert to 100 nanosecond units */
1598 t_write.ull_time *= 10000000ULL;
1599
1600 SetFileTime(h, NULL, NULL, &t_write.ft_time);
1601 CloseHandle (h);
1602 return;
1603
1604 #else
1605 struct utimbuf utimbuf;
1606 time_t t;
1607
1608 /* Set modification time to requested time. */
1609 utimbuf.modtime = time_stamp;
1610
1611 /* Set access time to now in local time. */
1612 t = time (NULL);
1613 utimbuf.actime = mktime (localtime (&t));
1614
1615 utime (name, &utimbuf);
1616 #endif
1617 }
1618
1619 /* Get the list of installed standard libraries from the
1620 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1621 key. */
1622
1623 char *
__gnat_get_libraries_from_registry(void)1624 __gnat_get_libraries_from_registry (void)
1625 {
1626 char *result = (char *) xmalloc (1);
1627
1628 result[0] = '\0';
1629
1630 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
1631
1632 HKEY reg_key;
1633 DWORD name_size, value_size;
1634 char name[256];
1635 char value[256];
1636 DWORD type;
1637 DWORD index;
1638 LONG res;
1639
1640 /* First open the key. */
1641 res = RegOpenKeyExA (HKEY_LOCAL_MACHINE, "SOFTWARE", 0, KEY_READ, ®_key);
1642
1643 if (res == ERROR_SUCCESS)
1644 res = RegOpenKeyExA (reg_key, "Ada Core Technologies", 0,
1645 KEY_READ, ®_key);
1646
1647 if (res == ERROR_SUCCESS)
1648 res = RegOpenKeyExA (reg_key, "GNAT", 0, KEY_READ, ®_key);
1649
1650 if (res == ERROR_SUCCESS)
1651 res = RegOpenKeyExA (reg_key, "Standard Libraries", 0, KEY_READ, ®_key);
1652
1653 /* If the key exists, read out all the values in it and concatenate them
1654 into a path. */
1655 for (index = 0; res == ERROR_SUCCESS; index++)
1656 {
1657 value_size = name_size = 256;
1658 res = RegEnumValueA (reg_key, index, name, &name_size, 0,
1659 &type, (LPBYTE)value, &value_size);
1660
1661 if (res == ERROR_SUCCESS && type == REG_SZ)
1662 {
1663 char *old_result = result;
1664
1665 result = (char *) xmalloc (strlen (old_result) + value_size + 2);
1666 strcpy (result, old_result);
1667 strcat (result, value);
1668 strcat (result, ";");
1669 free (old_result);
1670 }
1671 }
1672
1673 /* Remove the trailing ";". */
1674 if (result[0] != 0)
1675 result[strlen (result) - 1] = 0;
1676
1677 #endif
1678 return result;
1679 }
1680
1681 /* Query information for the given file NAME and return it in STATBUF.
1682 * Returns 0 for success, or errno value for failure.
1683 */
1684 int
__gnat_stat(char * name,GNAT_STRUCT_STAT * statbuf)1685 __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
1686 {
1687 #ifdef __MINGW32__
1688 WIN32_FILE_ATTRIBUTE_DATA fad;
1689 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
1690 int name_len;
1691 BOOL res;
1692 DWORD error;
1693
1694 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
1695 name_len = _tcslen (wname);
1696
1697 if (name_len > GNAT_MAX_PATH_LEN)
1698 return EINVAL;
1699
1700 ZeroMemory (statbuf, sizeof(GNAT_STRUCT_STAT));
1701
1702 res = GetFileAttributesEx (wname, GetFileExInfoStandard, &fad);
1703
1704 if (res == FALSE) {
1705 error = GetLastError();
1706
1707 /* Check file existence using GetFileAttributes() which does not fail on
1708 special Windows files like con:, aux:, nul: etc... */
1709
1710 if (GetFileAttributes(wname) != INVALID_FILE_ATTRIBUTES) {
1711 /* Just pretend that it is a regular and readable file */
1712 statbuf->st_mode = S_IFREG | S_IREAD | S_IWRITE;
1713 return 0;
1714 }
1715
1716 switch (error) {
1717 case ERROR_ACCESS_DENIED:
1718 case ERROR_SHARING_VIOLATION:
1719 case ERROR_LOCK_VIOLATION:
1720 case ERROR_SHARING_BUFFER_EXCEEDED:
1721 return EACCES;
1722 case ERROR_BUFFER_OVERFLOW:
1723 return ENAMETOOLONG;
1724 case ERROR_NOT_ENOUGH_MEMORY:
1725 return ENOMEM;
1726 default:
1727 return ENOENT;
1728 }
1729 }
1730
1731 f2t (&fad.ftCreationTime, &statbuf->st_ctime);
1732 f2t (&fad.ftLastWriteTime, &statbuf->st_mtime);
1733 f2t (&fad.ftLastAccessTime, &statbuf->st_atime);
1734
1735 statbuf->st_size =
1736 (__int64)fad.nFileSizeLow | (__int64)fad.nFileSizeHigh << 32;
1737
1738 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1739 statbuf->st_mode = S_IREAD;
1740
1741 if (fad.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)
1742 statbuf->st_mode |= S_IFDIR;
1743 else
1744 statbuf->st_mode |= S_IFREG;
1745
1746 if (!(fad.dwFileAttributes & FILE_ATTRIBUTE_READONLY))
1747 statbuf->st_mode |= S_IWRITE;
1748
1749 return 0;
1750
1751 #else
1752 return GNAT_STAT (name, statbuf) == 0 ? 0 : errno;
1753 #endif
1754 }
1755
1756 /*************************************************************************
1757 ** Check whether a file exists
1758 *************************************************************************/
1759
1760 int
__gnat_file_exists_attr(char * name,struct file_attributes * attr)1761 __gnat_file_exists_attr (char* name, struct file_attributes* attr)
1762 {
1763 if (attr->exists == ATTR_UNSET)
1764 __gnat_stat_to_attr (-1, name, attr);
1765
1766 return attr->exists;
1767 }
1768
1769 int
__gnat_file_exists(char * name)1770 __gnat_file_exists (char *name)
1771 {
1772 struct file_attributes attr;
1773 __gnat_reset_attributes (&attr);
1774 return __gnat_file_exists_attr (name, &attr);
1775 }
1776
1777 /**********************************************************************
1778 ** Whether name is an absolute path
1779 **********************************************************************/
1780
1781 int
__gnat_is_absolute_path(char * name,int length)1782 __gnat_is_absolute_path (char *name, int length)
1783 {
1784 #ifdef __vxworks
1785 /* On VxWorks systems, an absolute path can be represented (depending on
1786 the host platform) as either /dir/file, or device:/dir/file, or
1787 device:drive_letter:/dir/file. */
1788
1789 int index;
1790
1791 if (name[0] == '/')
1792 return 1;
1793
1794 for (index = 0; index < length; index++)
1795 {
1796 if (name[index] == ':' &&
1797 ((name[index + 1] == '/') ||
1798 (isalpha (name[index + 1]) && index + 2 <= length &&
1799 name[index + 2] == '/')))
1800 return 1;
1801
1802 else if (name[index] == '/')
1803 return 0;
1804 }
1805 return 0;
1806 #else
1807 return (length != 0) &&
1808 (IS_DIRECTORY_SEPARATOR(*name)
1809 #if defined (WINNT) || defined(__DJGPP__)
1810 || (length > 2 && ISALPHA (name[0]) && name[1] == ':'
1811 && IS_DIRECTORY_SEPARATOR(name[2]))
1812 #endif
1813 );
1814 #endif
1815 }
1816
1817 int
__gnat_is_regular_file_attr(char * name,struct file_attributes * attr)1818 __gnat_is_regular_file_attr (char* name, struct file_attributes* attr)
1819 {
1820 if (attr->regular == ATTR_UNSET)
1821 __gnat_stat_to_attr (-1, name, attr);
1822
1823 return attr->regular;
1824 }
1825
1826 int
__gnat_is_regular_file(char * name)1827 __gnat_is_regular_file (char *name)
1828 {
1829 struct file_attributes attr;
1830
1831 __gnat_reset_attributes (&attr);
1832 return __gnat_is_regular_file_attr (name, &attr);
1833 }
1834
1835 int
__gnat_is_regular_file_fd(int fd)1836 __gnat_is_regular_file_fd (int fd)
1837 {
1838 int ret;
1839 GNAT_STRUCT_STAT statbuf;
1840
1841 ret = GNAT_FSTAT (fd, &statbuf);
1842 return (!ret && S_ISREG (statbuf.st_mode));
1843 }
1844
1845 int
__gnat_is_directory_attr(char * name,struct file_attributes * attr)1846 __gnat_is_directory_attr (char* name, struct file_attributes* attr)
1847 {
1848 if (attr->directory == ATTR_UNSET)
1849 __gnat_stat_to_attr (-1, name, attr);
1850
1851 return attr->directory;
1852 }
1853
1854 int
__gnat_is_directory(char * name)1855 __gnat_is_directory (char *name)
1856 {
1857 struct file_attributes attr;
1858
1859 __gnat_reset_attributes (&attr);
1860 return __gnat_is_directory_attr (name, &attr);
1861 }
1862
1863 #if defined (_WIN32)
1864
1865 /* Returns the same constant as GetDriveType but takes a pathname as
1866 argument. */
1867
1868 static UINT
GetDriveTypeFromPath(TCHAR * wfullpath)1869 GetDriveTypeFromPath (TCHAR *wfullpath)
1870 {
1871 TCHAR wdrv[MAX_PATH];
1872 TCHAR wpath[MAX_PATH];
1873 TCHAR wfilename[MAX_PATH];
1874 TCHAR wext[MAX_PATH];
1875
1876 _tsplitpath (wfullpath, wdrv, wpath, wfilename, wext);
1877
1878 if (_tcslen (wdrv) != 0)
1879 {
1880 /* we have a drive specified. */
1881 _tcscat (wdrv, _T("\\"));
1882 return GetDriveType (wdrv);
1883 }
1884 else
1885 {
1886 /* No drive specified. */
1887
1888 /* Is this a relative path, if so get current drive type. */
1889 if (wpath[0] != _T('\\') ||
1890 (_tcslen (wpath) > 2 && wpath[0] == _T('\\')
1891 && wpath[1] != _T('\\')))
1892 return GetDriveType (NULL);
1893
1894 UINT result = GetDriveType (wpath);
1895
1896 /* Cannot guess the drive type, is this \\.\ ? */
1897
1898 if (result == DRIVE_NO_ROOT_DIR &&
1899 _tcslen (wpath) >= 4 && wpath[0] == _T('\\') && wpath[1] == _T('\\')
1900 && wpath[2] == _T('.') && wpath[3] == _T('\\'))
1901 {
1902 if (_tcslen (wpath) == 4)
1903 _tcscat (wpath, wfilename);
1904
1905 LPTSTR p = &wpath[4];
1906 LPTSTR b = _tcschr (p, _T('\\'));
1907
1908 if (b != NULL)
1909 {
1910 /* logical drive \\.\c\dir\file */
1911 *b++ = _T(':');
1912 *b++ = _T('\\');
1913 *b = _T('\0');
1914 }
1915 else
1916 _tcscat (p, _T(":\\"));
1917
1918 return GetDriveType (p);
1919 }
1920
1921 return result;
1922 }
1923 }
1924
1925 /* This MingW section contains code to work with ACL. */
1926 static int
__gnat_check_OWNER_ACL(TCHAR * wname,DWORD CheckAccessDesired,GENERIC_MAPPING CheckGenericMapping)1927 __gnat_check_OWNER_ACL (TCHAR *wname,
1928 DWORD CheckAccessDesired,
1929 GENERIC_MAPPING CheckGenericMapping)
1930 {
1931 DWORD dwAccessDesired, dwAccessAllowed;
1932 PRIVILEGE_SET PrivilegeSet;
1933 DWORD dwPrivSetSize = sizeof (PRIVILEGE_SET);
1934 BOOL fAccessGranted = FALSE;
1935 HANDLE hToken = NULL;
1936 DWORD nLength = 0;
1937 PSECURITY_DESCRIPTOR pSD = NULL;
1938
1939 GetFileSecurity
1940 (wname, OWNER_SECURITY_INFORMATION |
1941 GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION,
1942 NULL, 0, &nLength);
1943
1944 if ((pSD = (SECURITY_DESCRIPTOR *) HeapAlloc
1945 (GetProcessHeap (), HEAP_ZERO_MEMORY, nLength)) == NULL)
1946 return 0;
1947
1948 /* Obtain the security descriptor. */
1949
1950 if (!GetFileSecurity
1951 (wname, OWNER_SECURITY_INFORMATION |
1952 GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION,
1953 pSD, nLength, &nLength))
1954 goto error;
1955
1956 if (!ImpersonateSelf (SecurityImpersonation))
1957 goto error;
1958
1959 if (!OpenThreadToken
1960 (GetCurrentThread(), TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken))
1961 goto error;
1962
1963 /* Undoes the effect of ImpersonateSelf. */
1964
1965 RevertToSelf ();
1966
1967 /* We want to test for write permissions. */
1968
1969 dwAccessDesired = CheckAccessDesired;
1970
1971 MapGenericMask (&dwAccessDesired, &CheckGenericMapping);
1972
1973 if (!AccessCheck
1974 (pSD , /* security descriptor to check */
1975 hToken, /* impersonation token */
1976 dwAccessDesired, /* requested access rights */
1977 &CheckGenericMapping, /* pointer to GENERIC_MAPPING */
1978 &PrivilegeSet, /* receives privileges used in check */
1979 &dwPrivSetSize, /* size of PrivilegeSet buffer */
1980 &dwAccessAllowed, /* receives mask of allowed access rights */
1981 &fAccessGranted))
1982 goto error;
1983
1984 CloseHandle (hToken);
1985 HeapFree (GetProcessHeap (), 0, pSD);
1986 return fAccessGranted;
1987
1988 error:
1989 if (hToken)
1990 CloseHandle (hToken);
1991 HeapFree (GetProcessHeap (), 0, pSD);
1992 return 0;
1993 }
1994
1995 static void
__gnat_set_OWNER_ACL(TCHAR * wname,ACCESS_MODE AccessMode,DWORD AccessPermissions)1996 __gnat_set_OWNER_ACL (TCHAR *wname,
1997 ACCESS_MODE AccessMode,
1998 DWORD AccessPermissions)
1999 {
2000 PACL pOldDACL = NULL;
2001 PACL pNewDACL = NULL;
2002 PSECURITY_DESCRIPTOR pSD = NULL;
2003 EXPLICIT_ACCESS ea;
2004 TCHAR username [100];
2005 DWORD unsize = 100;
2006
2007 /* Get current user, he will act as the owner */
2008
2009 if (!GetUserName (username, &unsize))
2010 return;
2011
2012 if (GetNamedSecurityInfo
2013 (wname,
2014 SE_FILE_OBJECT,
2015 DACL_SECURITY_INFORMATION,
2016 NULL, NULL, &pOldDACL, NULL, &pSD) != ERROR_SUCCESS)
2017 return;
2018
2019 BuildExplicitAccessWithName
2020 (&ea, username, AccessPermissions, (ACCESS_MODE) AccessMode, NO_INHERITANCE);
2021
2022 if (AccessMode == SET_ACCESS)
2023 {
2024 /* SET_ACCESS, we want to set an explicte set of permissions, do not
2025 merge with current DACL. */
2026 if (SetEntriesInAcl (1, &ea, NULL, &pNewDACL) != ERROR_SUCCESS)
2027 return;
2028 }
2029 else
2030 if (SetEntriesInAcl (1, &ea, pOldDACL, &pNewDACL) != ERROR_SUCCESS)
2031 return;
2032
2033 if (SetNamedSecurityInfo
2034 (wname, SE_FILE_OBJECT,
2035 DACL_SECURITY_INFORMATION, NULL, NULL, pNewDACL, NULL) != ERROR_SUCCESS)
2036 return;
2037
2038 LocalFree (pSD);
2039 LocalFree (pNewDACL);
2040 }
2041
2042 /* Check if it is possible to use ACL for wname, the file must not be on a
2043 network drive. */
2044
2045 static int
__gnat_can_use_acl(TCHAR * wname)2046 __gnat_can_use_acl (TCHAR *wname)
2047 {
2048 return __gnat_use_acl && GetDriveTypeFromPath (wname) != DRIVE_REMOTE;
2049 }
2050
2051 #endif /* defined (_WIN32) */
2052
2053 int
__gnat_is_readable_file_attr(char * name,struct file_attributes * attr)2054 __gnat_is_readable_file_attr (char* name, struct file_attributes* attr)
2055 {
2056 if (attr->readable == ATTR_UNSET)
2057 {
2058 #if defined (_WIN32)
2059 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2060 GENERIC_MAPPING GenericMapping;
2061
2062 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2063
2064 if (__gnat_can_use_acl (wname))
2065 {
2066 ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
2067 GenericMapping.GenericRead = GENERIC_READ;
2068 attr->readable =
2069 __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
2070 }
2071 else
2072 attr->readable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
2073 #else
2074 __gnat_stat_to_attr (-1, name, attr);
2075 #endif
2076 }
2077
2078 return attr->readable;
2079 }
2080
2081 int
__gnat_is_read_accessible_file(char * name)2082 __gnat_is_read_accessible_file (char *name)
2083 {
2084 #if defined (_WIN32)
2085 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2086
2087 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2088
2089 return !_waccess (wname, 4);
2090
2091 #elif defined (__vxworks)
2092 int fd;
2093
2094 if ((fd = open (name, O_RDONLY, 0)) < 0)
2095 return 0;
2096 close (fd);
2097 return 1;
2098
2099 #else
2100 return !access (name, R_OK);
2101 #endif
2102 }
2103
2104 int
__gnat_is_readable_file(char * name)2105 __gnat_is_readable_file (char *name)
2106 {
2107 struct file_attributes attr;
2108
2109 __gnat_reset_attributes (&attr);
2110 return __gnat_is_readable_file_attr (name, &attr);
2111 }
2112
2113 int
__gnat_is_writable_file_attr(char * name,struct file_attributes * attr)2114 __gnat_is_writable_file_attr (char* name, struct file_attributes* attr)
2115 {
2116 if (attr->writable == ATTR_UNSET)
2117 {
2118 #if defined (_WIN32)
2119 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2120 GENERIC_MAPPING GenericMapping;
2121
2122 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2123
2124 if (__gnat_can_use_acl (wname))
2125 {
2126 ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
2127 GenericMapping.GenericWrite = GENERIC_WRITE;
2128
2129 attr->writable = __gnat_check_OWNER_ACL
2130 (wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
2131 && !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
2132 }
2133 else
2134 attr->writable =
2135 !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
2136
2137 #else
2138 __gnat_stat_to_attr (-1, name, attr);
2139 #endif
2140 }
2141
2142 return attr->writable;
2143 }
2144
2145 int
__gnat_is_writable_file(char * name)2146 __gnat_is_writable_file (char *name)
2147 {
2148 struct file_attributes attr;
2149
2150 __gnat_reset_attributes (&attr);
2151 return __gnat_is_writable_file_attr (name, &attr);
2152 }
2153
2154 int
__gnat_is_write_accessible_file(char * name)2155 __gnat_is_write_accessible_file (char *name)
2156 {
2157 #if defined (_WIN32)
2158 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2159
2160 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2161
2162 return !_waccess (wname, 2);
2163
2164 #elif defined (__vxworks)
2165 int fd;
2166
2167 if ((fd = open (name, O_WRONLY, 0)) < 0)
2168 return 0;
2169 close (fd);
2170 return 1;
2171
2172 #else
2173 return !access (name, W_OK);
2174 #endif
2175 }
2176
2177 int
__gnat_is_executable_file_attr(char * name,struct file_attributes * attr)2178 __gnat_is_executable_file_attr (char* name, struct file_attributes* attr)
2179 {
2180 if (attr->executable == ATTR_UNSET)
2181 {
2182 #if defined (_WIN32)
2183 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2184 GENERIC_MAPPING GenericMapping;
2185
2186 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2187
2188 if (__gnat_can_use_acl (wname))
2189 {
2190 ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
2191 GenericMapping.GenericExecute = GENERIC_EXECUTE;
2192
2193 attr->executable =
2194 __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
2195 }
2196 else
2197 {
2198 TCHAR *l, *last = _tcsstr(wname, _T(".exe"));
2199
2200 /* look for last .exe */
2201 if (last)
2202 while ((l = _tcsstr(last+1, _T(".exe"))))
2203 last = l;
2204
2205 attr->executable =
2206 GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
2207 && (last - wname) == (int) (_tcslen (wname) - 4);
2208 }
2209 #else
2210 __gnat_stat_to_attr (-1, name, attr);
2211 #endif
2212 }
2213
2214 return attr->regular && attr->executable;
2215 }
2216
2217 int
__gnat_is_executable_file(char * name)2218 __gnat_is_executable_file (char *name)
2219 {
2220 struct file_attributes attr;
2221
2222 __gnat_reset_attributes (&attr);
2223 return __gnat_is_executable_file_attr (name, &attr);
2224 }
2225
2226 void
__gnat_set_writable(char * name)2227 __gnat_set_writable (char *name)
2228 {
2229 #if defined (_WIN32)
2230 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2231
2232 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2233
2234 if (__gnat_can_use_acl (wname))
2235 __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_WRITE);
2236
2237 SetFileAttributes
2238 (wname, GetFileAttributes (wname) & ~FILE_ATTRIBUTE_READONLY);
2239 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2240 GNAT_STRUCT_STAT statbuf;
2241
2242 if (GNAT_STAT (name, &statbuf) == 0)
2243 {
2244 statbuf.st_mode = statbuf.st_mode | S_IWUSR;
2245 chmod (name, statbuf.st_mode);
2246 }
2247 #endif
2248 }
2249
2250 /* must match definition in s-os_lib.ads */
2251 #define S_OWNER 1
2252 #define S_GROUP 2
2253 #define S_OTHERS 4
2254
2255 void
__gnat_set_executable(char * name,int mode ATTRIBUTE_UNUSED)2256 __gnat_set_executable (char *name, int mode ATTRIBUTE_UNUSED)
2257 {
2258 #if defined (_WIN32)
2259 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2260
2261 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2262
2263 if (__gnat_can_use_acl (wname))
2264 __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE);
2265
2266 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2267 GNAT_STRUCT_STAT statbuf;
2268
2269 if (GNAT_STAT (name, &statbuf) == 0)
2270 {
2271 if (mode & S_OWNER)
2272 statbuf.st_mode = statbuf.st_mode | S_IXUSR;
2273 if (mode & S_GROUP)
2274 statbuf.st_mode = statbuf.st_mode | S_IXGRP;
2275 if (mode & S_OTHERS)
2276 statbuf.st_mode = statbuf.st_mode | S_IXOTH;
2277 chmod (name, statbuf.st_mode);
2278 }
2279 #endif
2280 }
2281
2282 void
__gnat_set_non_writable(char * name)2283 __gnat_set_non_writable (char *name)
2284 {
2285 #if defined (_WIN32)
2286 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2287
2288 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2289
2290 if (__gnat_can_use_acl (wname))
2291 __gnat_set_OWNER_ACL
2292 (wname, DENY_ACCESS,
2293 FILE_WRITE_DATA | FILE_APPEND_DATA |
2294 FILE_WRITE_EA | FILE_WRITE_ATTRIBUTES);
2295
2296 SetFileAttributes
2297 (wname, GetFileAttributes (wname) | FILE_ATTRIBUTE_READONLY);
2298 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2299 GNAT_STRUCT_STAT statbuf;
2300
2301 if (GNAT_STAT (name, &statbuf) == 0)
2302 {
2303 statbuf.st_mode = statbuf.st_mode & 07577;
2304 chmod (name, statbuf.st_mode);
2305 }
2306 #endif
2307 }
2308
2309 void
__gnat_set_readable(char * name)2310 __gnat_set_readable (char *name)
2311 {
2312 #if defined (_WIN32)
2313 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2314
2315 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2316
2317 if (__gnat_can_use_acl (wname))
2318 __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ);
2319
2320 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2321 GNAT_STRUCT_STAT statbuf;
2322
2323 if (GNAT_STAT (name, &statbuf) == 0)
2324 {
2325 chmod (name, statbuf.st_mode | S_IREAD);
2326 }
2327 #endif
2328 }
2329
2330 void
__gnat_set_non_readable(char * name)2331 __gnat_set_non_readable (char *name)
2332 {
2333 #if defined (_WIN32)
2334 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2335
2336 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2337
2338 if (__gnat_can_use_acl (wname))
2339 __gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ);
2340
2341 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2342 GNAT_STRUCT_STAT statbuf;
2343
2344 if (GNAT_STAT (name, &statbuf) == 0)
2345 {
2346 chmod (name, statbuf.st_mode & (~S_IREAD));
2347 }
2348 #endif
2349 }
2350
2351 int
__gnat_is_symbolic_link_attr(char * name ATTRIBUTE_UNUSED,struct file_attributes * attr)2352 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED,
2353 struct file_attributes* attr)
2354 {
2355 if (attr->symbolic_link == ATTR_UNSET)
2356 {
2357 #if defined (__vxworks)
2358 attr->symbolic_link = 0;
2359
2360 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2361 int ret;
2362 GNAT_STRUCT_STAT statbuf;
2363 ret = GNAT_LSTAT (name, &statbuf);
2364 attr->symbolic_link = (!ret && S_ISLNK (statbuf.st_mode));
2365 #else
2366 attr->symbolic_link = 0;
2367 #endif
2368 }
2369 return attr->symbolic_link;
2370 }
2371
2372 int
__gnat_is_symbolic_link(char * name ATTRIBUTE_UNUSED)2373 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
2374 {
2375 struct file_attributes attr;
2376
2377 __gnat_reset_attributes (&attr);
2378 return __gnat_is_symbolic_link_attr (name, &attr);
2379 }
2380
2381 #if defined (__sun__)
2382 /* Using fork on Solaris will duplicate all the threads. fork1, which
2383 duplicates only the active thread, must be used instead, or spawning
2384 subprocess from a program with tasking will lead into numerous problems. */
2385 #define fork fork1
2386 #endif
2387
2388 int
__gnat_portable_spawn(char * args[]ATTRIBUTE_UNUSED)2389 __gnat_portable_spawn (char *args[] ATTRIBUTE_UNUSED)
2390 {
2391 int status ATTRIBUTE_UNUSED = 0;
2392 int finished ATTRIBUTE_UNUSED;
2393 int pid ATTRIBUTE_UNUSED;
2394
2395 #if defined (__vxworks) || defined(__PikeOS__)
2396 return -1;
2397
2398 #elif defined (__DJGPP__) || defined (_WIN32)
2399 /* args[0] must be quotes as it could contain a full pathname with spaces */
2400 char *args_0 = args[0];
2401 args[0] = (char *)xmalloc (strlen (args_0) + 3);
2402 strcpy (args[0], "\"");
2403 strcat (args[0], args_0);
2404 strcat (args[0], "\"");
2405
2406 status = spawnvp (P_WAIT, args_0, (char ** const)args);
2407
2408 /* restore previous value */
2409 free (args[0]);
2410 args[0] = (char *)args_0;
2411
2412 if (status < 0)
2413 return -1;
2414 else
2415 return status;
2416
2417 #else
2418
2419 pid = fork ();
2420 if (pid < 0)
2421 return -1;
2422
2423 if (pid == 0)
2424 {
2425 /* The child. */
2426 __gnat_in_child_after_fork = 1;
2427 if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
2428 _exit (1);
2429 }
2430
2431 /* The parent. */
2432 finished = waitpid (pid, &status, 0);
2433
2434 if (finished != pid || WIFEXITED (status) == 0)
2435 return -1;
2436
2437 return WEXITSTATUS (status);
2438 #endif
2439
2440 return 0;
2441 }
2442
2443 /* Create a copy of the given file descriptor.
2444 Return -1 if an error occurred. */
2445
2446 int
__gnat_dup(int oldfd)2447 __gnat_dup (int oldfd)
2448 {
2449 #if defined (__vxworks) && !defined (__RTP__)
2450 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2451 RTPs. */
2452 return -1;
2453 #else
2454 return dup (oldfd);
2455 #endif
2456 }
2457
2458 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2459 Return -1 if an error occurred. */
2460
2461 int
__gnat_dup2(int oldfd ATTRIBUTE_UNUSED,int newfd ATTRIBUTE_UNUSED)2462 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED, int newfd ATTRIBUTE_UNUSED)
2463 {
2464 #if defined (__vxworks) && !defined (__RTP__)
2465 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2466 RTPs. */
2467 return -1;
2468 #elif defined (__PikeOS__)
2469 /* Not supported. */
2470 return -1;
2471 #elif defined (_WIN32)
2472 /* Special case when oldfd and newfd are identical and are the standard
2473 input, output or error as this makes Windows XP hangs. Note that we
2474 do that only for standard file descriptors that are known to be valid. */
2475 if (oldfd == newfd && newfd >= 0 && newfd <= 2)
2476 return newfd;
2477 else
2478 return dup2 (oldfd, newfd);
2479 #else
2480 return dup2 (oldfd, newfd);
2481 #endif
2482 }
2483
2484 int
__gnat_number_of_cpus(void)2485 __gnat_number_of_cpus (void)
2486 {
2487 int cores = 1;
2488
2489 #ifdef _SC_NPROCESSORS_ONLN
2490 cores = (int) sysconf (_SC_NPROCESSORS_ONLN);
2491
2492 #elif defined (__QNX__)
2493 cores = (int) _syspage_ptr->num_cpu;
2494
2495 #elif defined (__hpux__)
2496 struct pst_dynamic psd;
2497 if (pstat_getdynamic (&psd, sizeof (psd), 1, 0) != -1)
2498 cores = (int) psd.psd_proc_cnt;
2499
2500 #elif defined (_WIN32)
2501 SYSTEM_INFO sysinfo;
2502 GetSystemInfo (&sysinfo);
2503 cores = (int) sysinfo.dwNumberOfProcessors;
2504
2505 #elif defined (_WRS_CONFIG_SMP)
2506 unsigned int vxCpuConfiguredGet (void);
2507
2508 cores = vxCpuConfiguredGet ();
2509
2510 #endif
2511
2512 return cores;
2513 }
2514
2515 /* WIN32 code to implement a wait call that wait for any child process. */
2516
2517 #if defined (_WIN32)
2518
2519 /* Synchronization code, to be thread safe. */
2520
2521 #ifdef CERT
2522
2523 /* For the Cert run times on native Windows we use dummy functions
2524 for locking and unlocking tasks since we do not support multiple
2525 threads on this configuration (Cert run time on native Windows). */
2526
EnterCS(void)2527 static void EnterCS (void) {}
LeaveCS(void)2528 static void LeaveCS (void) {}
SignalListChanged(void)2529 static void SignalListChanged (void) {}
2530
2531 #else
2532
2533 CRITICAL_SECTION ProcListCS;
2534 HANDLE ProcListEvt = NULL;
2535
EnterCS(void)2536 static void EnterCS (void)
2537 {
2538 EnterCriticalSection(&ProcListCS);
2539 }
2540
LeaveCS(void)2541 static void LeaveCS (void)
2542 {
2543 LeaveCriticalSection(&ProcListCS);
2544 }
2545
SignalListChanged(void)2546 static void SignalListChanged (void)
2547 {
2548 SetEvent (ProcListEvt);
2549 }
2550
2551 #endif
2552
2553 static HANDLE *HANDLES_LIST = NULL;
2554 static int *PID_LIST = NULL, plist_length = 0, plist_max_length = 0;
2555
2556 static void
add_handle(HANDLE h,int pid)2557 add_handle (HANDLE h, int pid)
2558 {
2559 /* -------------------- critical section -------------------- */
2560 EnterCS();
2561
2562 if (plist_length == plist_max_length)
2563 {
2564 plist_max_length += 100;
2565 HANDLES_LIST =
2566 (HANDLE *) xrealloc (HANDLES_LIST, sizeof (HANDLE) * plist_max_length);
2567 PID_LIST =
2568 (int *) xrealloc (PID_LIST, sizeof (int) * plist_max_length);
2569 }
2570
2571 HANDLES_LIST[plist_length] = h;
2572 PID_LIST[plist_length] = pid;
2573 ++plist_length;
2574
2575 SignalListChanged();
2576 LeaveCS();
2577 /* -------------------- critical section -------------------- */
2578 }
2579
2580 int
__gnat_win32_remove_handle(HANDLE h,int pid)2581 __gnat_win32_remove_handle (HANDLE h, int pid)
2582 {
2583 int j;
2584 int found = 0;
2585
2586 /* -------------------- critical section -------------------- */
2587 EnterCS();
2588
2589 for (j = 0; j < plist_length; j++)
2590 {
2591 if ((HANDLES_LIST[j] == h) || (PID_LIST[j] == pid))
2592 {
2593 CloseHandle (h);
2594 --plist_length;
2595 HANDLES_LIST[j] = HANDLES_LIST[plist_length];
2596 PID_LIST[j] = PID_LIST[plist_length];
2597 found = 1;
2598 break;
2599 }
2600 }
2601
2602 LeaveCS();
2603 /* -------------------- critical section -------------------- */
2604
2605 if (found)
2606 SignalListChanged();
2607
2608 return found;
2609 }
2610
2611 static void
win32_no_block_spawn(char * command,char * args[],HANDLE * h,int * pid)2612 win32_no_block_spawn (char *command, char *args[], HANDLE *h, int *pid)
2613 {
2614 BOOL result;
2615 STARTUPINFO SI;
2616 PROCESS_INFORMATION PI;
2617 SECURITY_ATTRIBUTES SA;
2618 int csize = 1;
2619 char *full_command;
2620 int k;
2621
2622 /* compute the total command line length */
2623 k = 0;
2624 while (args[k])
2625 {
2626 csize += strlen (args[k]) + 1;
2627 k++;
2628 }
2629
2630 full_command = (char *) xmalloc (csize);
2631
2632 /* Startup info. */
2633 SI.cb = sizeof (STARTUPINFO);
2634 SI.lpReserved = NULL;
2635 SI.lpReserved2 = NULL;
2636 SI.lpDesktop = NULL;
2637 SI.cbReserved2 = 0;
2638 SI.lpTitle = NULL;
2639 SI.dwFlags = 0;
2640 SI.wShowWindow = SW_HIDE;
2641
2642 /* Security attributes. */
2643 SA.nLength = sizeof (SECURITY_ATTRIBUTES);
2644 SA.bInheritHandle = TRUE;
2645 SA.lpSecurityDescriptor = NULL;
2646
2647 /* Prepare the command string. */
2648 strcpy (full_command, command);
2649 strcat (full_command, " ");
2650
2651 k = 1;
2652 while (args[k])
2653 {
2654 strcat (full_command, args[k]);
2655 strcat (full_command, " ");
2656 k++;
2657 }
2658
2659 {
2660 int wsize = csize * 2;
2661 TCHAR *wcommand = (TCHAR *) xmalloc (wsize);
2662
2663 S2WSC (wcommand, full_command, wsize);
2664
2665 free (full_command);
2666
2667 result = CreateProcess
2668 (NULL, wcommand, &SA, NULL, TRUE,
2669 GetPriorityClass (GetCurrentProcess()), NULL, NULL, &SI, &PI);
2670
2671 free (wcommand);
2672 }
2673
2674 if (result == TRUE)
2675 {
2676 CloseHandle (PI.hThread);
2677 *h = PI.hProcess;
2678 *pid = PI.dwProcessId;
2679 }
2680 else
2681 {
2682 *h = NULL;
2683 *pid = 0;
2684 }
2685 }
2686
2687 static int
win32_wait(int * status)2688 win32_wait (int *status)
2689 {
2690 DWORD exitcode, pid;
2691 HANDLE *hl;
2692 HANDLE h;
2693 int *pidl;
2694 DWORD res;
2695 int hl_len;
2696 int found;
2697 int pos;
2698
2699 START_WAIT:
2700
2701 if (plist_length == 0)
2702 {
2703 errno = ECHILD;
2704 return -1;
2705 }
2706
2707 /* -------------------- critical section -------------------- */
2708 EnterCS();
2709
2710 /* ??? We can't wait for more than MAXIMUM_WAIT_OBJECTS due to a Win32
2711 limitation */
2712 if (plist_length < MAXIMUM_WAIT_OBJECTS)
2713 hl_len = plist_length;
2714 else
2715 {
2716 errno = EINVAL;
2717 return -1;
2718 }
2719
2720 #ifdef CERT
2721 hl = (HANDLE *) xmalloc (sizeof (HANDLE) * hl_len);
2722 memmove (hl, HANDLES_LIST, sizeof (HANDLE) * hl_len);
2723 pidl = (int *) xmalloc (sizeof (int) * hl_len);
2724 memmove (pidl, PID_LIST, sizeof (int) * hl_len);
2725 #else
2726 /* Note that index 0 contains the event handle that is signaled when the
2727 process list has changed */
2728 hl = (HANDLE *) xmalloc (sizeof (HANDLE) * (hl_len + 1));
2729 hl[0] = ProcListEvt;
2730 memmove (&hl[1], HANDLES_LIST, sizeof (HANDLE) * hl_len);
2731 pidl = (int *) xmalloc (sizeof (int) * (hl_len + 1));
2732 memmove (&pidl[1], PID_LIST, sizeof (int) * hl_len);
2733 hl_len++;
2734 #endif
2735
2736 LeaveCS();
2737 /* -------------------- critical section -------------------- */
2738
2739 res = WaitForMultipleObjects (hl_len, hl, FALSE, INFINITE);
2740
2741 /* If there was an error, exit now */
2742 if (res == WAIT_FAILED)
2743 {
2744 free (hl);
2745 free (pidl);
2746 errno = EINVAL;
2747 return -1;
2748 }
2749
2750 /* if the ProcListEvt has been signaled then the list of processes has been
2751 updated to add or remove a handle, just loop over */
2752
2753 if (res - WAIT_OBJECT_0 == 0)
2754 {
2755 free (hl);
2756 free (pidl);
2757 goto START_WAIT;
2758 }
2759
2760 /* Handle two distinct groups of return codes: finished waits and abandoned
2761 waits */
2762
2763 if (res < WAIT_ABANDONED_0)
2764 pos = res - WAIT_OBJECT_0;
2765 else
2766 pos = res - WAIT_ABANDONED_0;
2767
2768 h = hl[pos];
2769 GetExitCodeProcess (h, &exitcode);
2770 pid = pidl [pos];
2771
2772 found = __gnat_win32_remove_handle (h, -1);
2773
2774 free (hl);
2775 free (pidl);
2776
2777 /* if not found another process waiting has already handled this process */
2778
2779 if (!found)
2780 {
2781 goto START_WAIT;
2782 }
2783
2784 *status = (int) exitcode;
2785 return (int) pid;
2786 }
2787
2788 #endif
2789
2790 int
__gnat_portable_no_block_spawn(char * args[]ATTRIBUTE_UNUSED)2791 __gnat_portable_no_block_spawn (char *args[] ATTRIBUTE_UNUSED)
2792 {
2793
2794 #if defined (__vxworks) || defined (__PikeOS__)
2795 /* Not supported. */
2796 return -1;
2797
2798 #elif defined(__DJGPP__)
2799 if (spawnvp (P_WAIT, args[0], args) != 0)
2800 return -1;
2801 else
2802 return 0;
2803
2804 #elif defined (_WIN32)
2805
2806 HANDLE h = NULL;
2807 int pid;
2808
2809 win32_no_block_spawn (args[0], args, &h, &pid);
2810 if (h != NULL)
2811 {
2812 add_handle (h, pid);
2813 return pid;
2814 }
2815 else
2816 return -1;
2817
2818 #else
2819
2820 int pid = fork ();
2821
2822 if (pid == 0)
2823 {
2824 /* The child. */
2825 if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
2826 _exit (1);
2827 }
2828
2829 return pid;
2830
2831 #endif
2832 }
2833
2834 int
__gnat_portable_wait(int * process_status)2835 __gnat_portable_wait (int *process_status)
2836 {
2837 int status = 0;
2838 int pid = 0;
2839
2840 #if defined (__vxworks) || defined (__PikeOS__)
2841 /* Not sure what to do here, so do nothing but return zero. */
2842
2843 #elif defined (_WIN32)
2844
2845 pid = win32_wait (&status);
2846
2847 #elif defined (__DJGPP__)
2848 /* Child process has already ended in case of DJGPP.
2849 No need to do anything. Just return success. */
2850 #else
2851
2852 pid = waitpid (-1, &status, 0);
2853 status = status & 0xffff;
2854 #endif
2855
2856 *process_status = status;
2857 return pid;
2858 }
2859
2860 int
__gnat_portable_no_block_wait(int * process_status)2861 __gnat_portable_no_block_wait (int *process_status)
2862 {
2863 int status = 0;
2864 int pid = 0;
2865
2866 #if defined (__vxworks) || defined (__PikeOS__) || defined (_WIN32)
2867 /* Not supported. */
2868 status = -1;
2869
2870 #else
2871
2872 pid = waitpid (-1, &status, WNOHANG);
2873 status = status & 0xffff;
2874 #endif
2875
2876 *process_status = status;
2877 return pid;
2878 }
2879
2880 void
__gnat_os_exit(int status)2881 __gnat_os_exit (int status)
2882 {
2883 exit (status);
2884 }
2885
2886 int
__gnat_current_process_id(void)2887 __gnat_current_process_id (void)
2888 {
2889 #if defined (__vxworks) || defined (__PikeOS__)
2890 return -1;
2891
2892 #elif defined (_WIN32)
2893
2894 return (int)GetCurrentProcessId();
2895
2896 #else
2897
2898 return (int)getpid();
2899 #endif
2900 }
2901
2902 /* Locate file on path, that matches a predicate */
2903
2904 char *
__gnat_locate_file_with_predicate(char * file_name,char * path_val,int (* predicate)(char *))2905 __gnat_locate_file_with_predicate (char *file_name, char *path_val,
2906 int (*predicate)(char *))
2907 {
2908 char *ptr;
2909 char *file_path = (char *) alloca (strlen (file_name) + 1);
2910 int absolute;
2911
2912 /* Return immediately if file_name is empty */
2913
2914 if (*file_name == '\0')
2915 return 0;
2916
2917 /* Remove quotes around file_name if present */
2918
2919 ptr = file_name;
2920 if (*ptr == '"')
2921 ptr++;
2922
2923 strcpy (file_path, ptr);
2924
2925 ptr = file_path + strlen (file_path) - 1;
2926
2927 if (*ptr == '"')
2928 *ptr = '\0';
2929
2930 /* Handle absolute pathnames. */
2931
2932 absolute = __gnat_is_absolute_path (file_path, strlen (file_name));
2933
2934 if (absolute)
2935 {
2936 if (predicate (file_path))
2937 return xstrdup (file_path);
2938
2939 return 0;
2940 }
2941
2942 /* If file_name include directory separator(s), try it first as
2943 a path name relative to the current directory */
2944 for (ptr = file_name; *ptr && !IS_DIRECTORY_SEPARATOR(*ptr); ptr++)
2945 ;
2946
2947 if (*ptr != 0)
2948 {
2949 if (predicate (file_name))
2950 return xstrdup (file_name);
2951 }
2952
2953 if (path_val == 0)
2954 return 0;
2955
2956 {
2957 /* The result has to be smaller than path_val + file_name. */
2958 char *file_path =
2959 (char *) alloca (strlen (path_val) + strlen (file_name) + 2);
2960
2961 for (;;)
2962 {
2963 /* Skip the starting quote */
2964
2965 if (*path_val == '"')
2966 path_val++;
2967
2968 for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
2969 *ptr++ = *path_val++;
2970
2971 /* If directory is empty, it is the current directory*/
2972
2973 if (ptr == file_path)
2974 {
2975 *ptr = '.';
2976 }
2977 else
2978 ptr--;
2979
2980 /* Skip the ending quote */
2981
2982 if (*ptr == '"')
2983 ptr--;
2984
2985 if (!IS_DIRECTORY_SEPARATOR(*ptr))
2986 *++ptr = DIR_SEPARATOR;
2987
2988 strcpy (++ptr, file_name);
2989
2990 if (predicate (file_path))
2991 return xstrdup (file_path);
2992
2993 if (*path_val == 0)
2994 return 0;
2995
2996 /* Skip path separator */
2997
2998 path_val++;
2999 }
3000 }
3001
3002 return 0;
3003 }
3004
3005 /* Locate an executable file, give a Path value. */
3006
3007 char *
__gnat_locate_executable_file(char * file_name,char * path_val)3008 __gnat_locate_executable_file (char *file_name, char *path_val)
3009 {
3010 return __gnat_locate_file_with_predicate
3011 (file_name, path_val, &__gnat_is_executable_file);
3012 }
3013
3014 /* Locate a regular file, give a Path value. */
3015
3016 char *
__gnat_locate_regular_file(char * file_name,char * path_val)3017 __gnat_locate_regular_file (char *file_name, char *path_val)
3018 {
3019 return __gnat_locate_file_with_predicate
3020 (file_name, path_val, &__gnat_is_regular_file);
3021 }
3022
3023 /* Locate an executable given a Path argument. This routine is only used by
3024 gnatbl and should not be used otherwise. Use locate_exec_on_path
3025 instead. */
3026
3027 char *
__gnat_locate_exec(char * exec_name,char * path_val)3028 __gnat_locate_exec (char *exec_name, char *path_val)
3029 {
3030 const unsigned int len = strlen (HOST_EXECUTABLE_SUFFIX);
3031 char *ptr;
3032
3033 if (len > 0 && !strstr (exec_name, HOST_EXECUTABLE_SUFFIX))
3034 {
3035 char *full_exec_name = (char *) alloca (strlen (exec_name) + len + 1);
3036
3037 strcpy (full_exec_name, exec_name);
3038 strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
3039 ptr = __gnat_locate_executable_file (full_exec_name, path_val);
3040
3041 if (ptr == 0)
3042 return __gnat_locate_executable_file (exec_name, path_val);
3043 return ptr;
3044 }
3045 else
3046 return __gnat_locate_executable_file (exec_name, path_val);
3047 }
3048
3049 /* Locate an executable using the Systems default PATH. */
3050
3051 char *
__gnat_locate_exec_on_path(char * exec_name)3052 __gnat_locate_exec_on_path (char *exec_name)
3053 {
3054 char *apath_val;
3055
3056 #if defined (_WIN32)
3057 TCHAR *wpath_val = _tgetenv (_T("PATH"));
3058 TCHAR *wapath_val;
3059 /* In Win32 systems we expand the PATH as for XP environment
3060 variables are not automatically expanded. We also prepend the
3061 ".;" to the path to match normal NT path search semantics */
3062
3063 #define EXPAND_BUFFER_SIZE 32767
3064
3065 wapath_val = (TCHAR *) alloca (EXPAND_BUFFER_SIZE);
3066
3067 wapath_val [0] = '.';
3068 wapath_val [1] = ';';
3069
3070 DWORD res = ExpandEnvironmentStrings
3071 (wpath_val, &wapath_val[2], EXPAND_BUFFER_SIZE - 2);
3072
3073 if (!res) wapath_val [0] = _T('\0');
3074
3075 apath_val = (char *) alloca (EXPAND_BUFFER_SIZE);
3076
3077 WS2SC (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
3078
3079 #else
3080 const char *path_val = getenv ("PATH");
3081
3082 /* If PATH is not defined, proceed with __gnat_locate_exec anyway, so we can
3083 find files that contain directory names. */
3084
3085 if (path_val == NULL) path_val = "";
3086 apath_val = (char *) alloca (strlen (path_val) + 1);
3087 strcpy (apath_val, path_val);
3088 #endif
3089
3090 return __gnat_locate_exec (exec_name, apath_val);
3091 }
3092
3093 /* Dummy functions for Osint import for non-VMS systems.
3094 ??? To be removed. */
3095
3096 int
__gnat_to_canonical_file_list_init(char * dirspec ATTRIBUTE_UNUSED,int onlydirs ATTRIBUTE_UNUSED)3097 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED,
3098 int onlydirs ATTRIBUTE_UNUSED)
3099 {
3100 return 0;
3101 }
3102
3103 char *
__gnat_to_canonical_file_list_next(void)3104 __gnat_to_canonical_file_list_next (void)
3105 {
3106 static char empty[] = "";
3107 return empty;
3108 }
3109
3110 void
__gnat_to_canonical_file_list_free(void)3111 __gnat_to_canonical_file_list_free (void)
3112 {
3113 }
3114
3115 char *
__gnat_to_canonical_dir_spec(char * dirspec,int prefixflag ATTRIBUTE_UNUSED)3116 __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
3117 {
3118 return dirspec;
3119 }
3120
3121 char *
__gnat_to_canonical_file_spec(char * filespec)3122 __gnat_to_canonical_file_spec (char *filespec)
3123 {
3124 return filespec;
3125 }
3126
3127 char *
__gnat_to_canonical_path_spec(char * pathspec)3128 __gnat_to_canonical_path_spec (char *pathspec)
3129 {
3130 return pathspec;
3131 }
3132
3133 char *
__gnat_to_host_dir_spec(char * dirspec,int prefixflag ATTRIBUTE_UNUSED)3134 __gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
3135 {
3136 return dirspec;
3137 }
3138
3139 char *
__gnat_to_host_file_spec(char * filespec)3140 __gnat_to_host_file_spec (char *filespec)
3141 {
3142 return filespec;
3143 }
3144
3145 void
__gnat_adjust_os_resource_limits(void)3146 __gnat_adjust_os_resource_limits (void)
3147 {
3148 }
3149
3150 #if defined (__mips_vxworks)
3151 int
_flush_cache(void)3152 _flush_cache (void)
3153 {
3154 CACHE_USER_FLUSH (0, ENTIRE_CACHE);
3155 }
3156 #endif
3157
3158 #if defined (_WIN32)
3159 int __gnat_argument_needs_quote = 1;
3160 #else
3161 int __gnat_argument_needs_quote = 0;
3162 #endif
3163
3164 /* This option is used to enable/disable object files handling from the
3165 binder file by the GNAT Project module. For example, this is disabled on
3166 Windows (prior to GCC 3.4) as it is already done by the mdll module.
3167 Stating with GCC 3.4 the shared libraries are not based on mdll
3168 anymore as it uses the GCC's -shared option */
3169 #if defined (_WIN32) \
3170 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
3171 int __gnat_prj_add_obj_files = 0;
3172 #else
3173 int __gnat_prj_add_obj_files = 1;
3174 #endif
3175
3176 /* char used as prefix/suffix for environment variables */
3177 #if defined (_WIN32)
3178 char __gnat_environment_char = '%';
3179 #else
3180 char __gnat_environment_char = '$';
3181 #endif
3182
3183 /* This functions copy the file attributes from a source file to a
3184 destination file.
3185
3186 mode = 0 : In this mode copy only the file time stamps (last access and
3187 last modification time stamps).
3188
3189 mode = 1 : In this mode, time stamps and read/write/execute attributes are
3190 copied.
3191
3192 mode = 2 : In this mode, only read/write/execute attributes are copied
3193
3194 Returns 0 if operation was successful and -1 in case of error. */
3195
3196 int
__gnat_copy_attribs(char * from ATTRIBUTE_UNUSED,char * to ATTRIBUTE_UNUSED,int mode ATTRIBUTE_UNUSED)3197 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED,
3198 int mode ATTRIBUTE_UNUSED)
3199 {
3200 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
3201 return -1;
3202
3203 #elif defined (_WIN32)
3204 TCHAR wfrom [GNAT_MAX_PATH_LEN + 2];
3205 TCHAR wto [GNAT_MAX_PATH_LEN + 2];
3206 BOOL res;
3207 FILETIME fct, flat, flwt;
3208 HANDLE hfrom, hto;
3209
3210 S2WSC (wfrom, from, GNAT_MAX_PATH_LEN + 2);
3211 S2WSC (wto, to, GNAT_MAX_PATH_LEN + 2);
3212
3213 /* Do we need to copy the timestamp ? */
3214
3215 if (mode != 2) {
3216 /* retrieve from times */
3217
3218 hfrom = CreateFile
3219 (wfrom, GENERIC_READ, 0, NULL, OPEN_EXISTING,
3220 FILE_ATTRIBUTE_NORMAL, NULL);
3221
3222 if (hfrom == INVALID_HANDLE_VALUE)
3223 return -1;
3224
3225 res = GetFileTime (hfrom, &fct, &flat, &flwt);
3226
3227 CloseHandle (hfrom);
3228
3229 if (res == 0)
3230 return -1;
3231
3232 /* retrieve from times */
3233
3234 hto = CreateFile
3235 (wto, GENERIC_WRITE, 0, NULL, OPEN_EXISTING,
3236 FILE_ATTRIBUTE_NORMAL, NULL);
3237
3238 if (hto == INVALID_HANDLE_VALUE)
3239 return -1;
3240
3241 res = SetFileTime (hto, NULL, &flat, &flwt);
3242
3243 CloseHandle (hto);
3244
3245 if (res == 0)
3246 return -1;
3247 }
3248
3249 /* Do we need to copy the permissions ? */
3250 /* Set file attributes in full mode. */
3251
3252 if (mode != 0)
3253 {
3254 DWORD attribs = GetFileAttributes (wfrom);
3255
3256 if (attribs == INVALID_FILE_ATTRIBUTES)
3257 return -1;
3258
3259 res = SetFileAttributes (wto, attribs);
3260 if (res == 0)
3261 return -1;
3262 }
3263
3264 return 0;
3265
3266 #else
3267 GNAT_STRUCT_STAT fbuf;
3268
3269 if (GNAT_STAT (from, &fbuf) == -1) {
3270 return -1;
3271 }
3272
3273 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 7)
3274
3275 /* VxWorks prior to 7 only has utime. */
3276
3277 /* Do we need to copy the timestamp ? */
3278 if (mode != 2) {
3279 struct utimbuf tbuf;
3280
3281 tbuf.actime = fbuf.st_atime;
3282 tbuf.modtime = fbuf.st_mtime;
3283
3284 if (utime (to, &tbuf) == -1)
3285 return -1;
3286 }
3287
3288 #elif _POSIX_C_SOURCE >= 200809L
3289 struct timespec tbuf[2];
3290
3291 if (mode != 2) {
3292 tbuf[0] = fbuf.st_atim;
3293 tbuf[1] = fbuf.st_mtim;
3294
3295 if (utimensat (AT_FDCWD, to, tbuf, 0) == -1) {
3296 return -1;
3297 }
3298 }
3299
3300 #else
3301 struct timeval tbuf[2];
3302 /* Do we need to copy timestamp ? */
3303
3304 if (mode != 2) {
3305 tbuf[0].tv_sec = fbuf.st_atime;
3306 tbuf[1].tv_sec = fbuf.st_mtime;
3307
3308 #if defined(st_mtime)
3309 tbuf[0].tv_usec = fbuf.st_atim.tv_nsec / 1000;
3310 tbuf[1].tv_usec = fbuf.st_mtim.tv_nsec / 1000;
3311 #else
3312 tbuf[0].tv_usec = 0;
3313 tbuf[1].tv_usec = 0;
3314 #endif
3315
3316 if (utimes (to, tbuf) == -1) {
3317 return -1;
3318 }
3319 }
3320 #endif
3321
3322 /* Do we need to copy file permissions ? */
3323 if (mode != 0 && (chmod (to, fbuf.st_mode) == -1)) {
3324 return -1;
3325 }
3326
3327 return 0;
3328 #endif
3329 }
3330
3331 int
__gnat_lseek(int fd,long offset,int whence)3332 __gnat_lseek (int fd, long offset, int whence)
3333 {
3334 return (int) lseek (fd, offset, whence);
3335 }
3336
3337 /* This function returns the major version number of GCC being used. */
3338 int
get_gcc_version(void)3339 get_gcc_version (void)
3340 {
3341 #ifdef IN_RTS
3342 return __GNUC__;
3343 #else
3344 return (int) (version_string[0] - '0');
3345 #endif
3346 }
3347
3348 /*
3349 * Set Close_On_Exec as indicated.
3350 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
3351 */
3352
3353 int
__gnat_set_close_on_exec(int fd ATTRIBUTE_UNUSED,int close_on_exec_p ATTRIBUTE_UNUSED)3354 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED,
3355 int close_on_exec_p ATTRIBUTE_UNUSED)
3356 {
3357 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3358 int flags = fcntl (fd, F_GETFD, 0);
3359 if (flags < 0)
3360 return flags;
3361 if (close_on_exec_p)
3362 flags |= FD_CLOEXEC;
3363 else
3364 flags &= ~FD_CLOEXEC;
3365 return fcntl (fd, F_SETFD, flags);
3366 #elif defined(_WIN32)
3367 HANDLE h = (HANDLE) _get_osfhandle (fd);
3368 if (h == (HANDLE) -1)
3369 return -1;
3370 if (close_on_exec_p)
3371 return ! SetHandleInformation (h, HANDLE_FLAG_INHERIT, 0);
3372 return ! SetHandleInformation (h, HANDLE_FLAG_INHERIT,
3373 HANDLE_FLAG_INHERIT);
3374 #else
3375 /* TODO: Unimplemented. */
3376 return -1;
3377 #endif
3378 }
3379
3380 /* Indicates if platforms supports automatic initialization through the
3381 constructor mechanism */
3382 int
__gnat_binder_supports_auto_init(void)3383 __gnat_binder_supports_auto_init (void)
3384 {
3385 return 1;
3386 }
3387
3388 /* Indicates that Stand-Alone Libraries are automatically initialized through
3389 the constructor mechanism */
3390 int
__gnat_sals_init_using_constructors(void)3391 __gnat_sals_init_using_constructors (void)
3392 {
3393 #if defined (__vxworks) || defined (__Lynx__)
3394 return 0;
3395 #else
3396 return 1;
3397 #endif
3398 }
3399
3400 #if defined (__linux__) || defined (__ANDROID__)
3401 /* There is no function in the glibc to retrieve the LWP of the current
3402 thread. We need to do a system call in order to retrieve this
3403 information. */
3404 #include <sys/syscall.h>
3405 void *
__gnat_lwp_self(void)3406 __gnat_lwp_self (void)
3407 {
3408 return (void *) syscall (__NR_gettid);
3409 }
3410 #endif
3411
3412 #if defined (__APPLE__)
3413 # if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1060
3414 # include <mach/thread_info.h>
3415 # include <mach/mach_init.h>
3416 # include <mach/thread_act.h>
3417 # else
3418 # include <pthread.h>
3419 # endif
3420
3421 /* System-wide thread identifier. Note it could be truncated on 32 bit
3422 hosts.
3423 Previously was: pthread_mach_thread_np (pthread_self ()). */
3424 void *
__gnat_lwp_self(void)3425 __gnat_lwp_self (void)
3426 {
3427 #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1060
3428 thread_identifier_info_data_t data;
3429 mach_msg_type_number_t count = THREAD_IDENTIFIER_INFO_COUNT;
3430 kern_return_t kret;
3431
3432 kret = thread_info (mach_thread_self (), THREAD_IDENTIFIER_INFO,
3433 (thread_info_t) &data, &count);
3434 if (kret == KERN_SUCCESS)
3435 return (void *)(uintptr_t)data.thread_id;
3436 else
3437 return 0;
3438 #else
3439 return (void *)pthread_mach_thread_np (pthread_self ());
3440 #endif
3441 }
3442 #endif
3443
3444 #if defined (__linux__)
3445 #include <sched.h>
3446
3447 /* glibc versions earlier than 2.7 do not define the routines to handle
3448 dynamically allocated CPU sets. For these targets, we use the static
3449 versions. */
3450
3451 #ifdef CPU_ALLOC
3452
3453 /* Dynamic cpu sets */
3454
3455 cpu_set_t *
__gnat_cpu_alloc(size_t count)3456 __gnat_cpu_alloc (size_t count)
3457 {
3458 return CPU_ALLOC (count);
3459 }
3460
3461 size_t
__gnat_cpu_alloc_size(size_t count)3462 __gnat_cpu_alloc_size (size_t count)
3463 {
3464 return CPU_ALLOC_SIZE (count);
3465 }
3466
3467 void
__gnat_cpu_free(cpu_set_t * set)3468 __gnat_cpu_free (cpu_set_t *set)
3469 {
3470 CPU_FREE (set);
3471 }
3472
3473 void
__gnat_cpu_zero(size_t count,cpu_set_t * set)3474 __gnat_cpu_zero (size_t count, cpu_set_t *set)
3475 {
3476 CPU_ZERO_S (count, set);
3477 }
3478
3479 void
__gnat_cpu_set(int cpu,size_t count,cpu_set_t * set)3480 __gnat_cpu_set (int cpu, size_t count, cpu_set_t *set)
3481 {
3482 /* Ada handles CPU numbers starting from 1, while C identifies the first
3483 CPU by a 0, so we need to adjust. */
3484 CPU_SET_S (cpu - 1, count, set);
3485 }
3486
3487 #else /* !CPU_ALLOC */
3488
3489 /* Static cpu sets */
3490
3491 cpu_set_t *
__gnat_cpu_alloc(size_t count ATTRIBUTE_UNUSED)3492 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED)
3493 {
3494 return (cpu_set_t *) xmalloc (sizeof (cpu_set_t));
3495 }
3496
3497 size_t
__gnat_cpu_alloc_size(size_t count ATTRIBUTE_UNUSED)3498 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED)
3499 {
3500 return sizeof (cpu_set_t);
3501 }
3502
3503 void
__gnat_cpu_free(cpu_set_t * set)3504 __gnat_cpu_free (cpu_set_t *set)
3505 {
3506 free (set);
3507 }
3508
3509 void
__gnat_cpu_zero(size_t count ATTRIBUTE_UNUSED,cpu_set_t * set)3510 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
3511 {
3512 CPU_ZERO (set);
3513 }
3514
3515 void
__gnat_cpu_set(int cpu,size_t count ATTRIBUTE_UNUSED,cpu_set_t * set)3516 __gnat_cpu_set (int cpu, size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
3517 {
3518 /* Ada handles CPU numbers starting from 1, while C identifies the first
3519 CPU by a 0, so we need to adjust. */
3520 CPU_SET (cpu - 1, set);
3521 }
3522 #endif /* !CPU_ALLOC */
3523 #endif /* __linux__ */
3524
3525 /* Return the load address of the executable, or 0 if not known. In the
3526 specific case of error, (void *)-1 can be returned. Beware: this unit may
3527 be in a shared library. As low-level units are needed, we allow #include
3528 here. */
3529
3530 #if defined (__APPLE__)
3531 #include <mach-o/dyld.h>
3532 #endif
3533
3534 const void *
__gnat_get_executable_load_address(void)3535 __gnat_get_executable_load_address (void)
3536 {
3537 #if defined (__APPLE__)
3538 return _dyld_get_image_header (0);
3539
3540 #elif 0 && defined (__linux__)
3541 /* Currently disabled as it needs at least -ldl. */
3542 struct link_map *map = _r_debug.r_map;
3543
3544 return (const void *)map->l_addr;
3545
3546 #else
3547 return NULL;
3548 #endif
3549 }
3550
3551 void
__gnat_kill(int pid,int sig,int close ATTRIBUTE_UNUSED)3552 __gnat_kill (int pid, int sig, int close ATTRIBUTE_UNUSED)
3553 {
3554 #if defined(_WIN32)
3555 HANDLE h = OpenProcess (PROCESS_ALL_ACCESS, FALSE, pid);
3556 if (h == NULL)
3557 return;
3558 if (sig == 9)
3559 {
3560 TerminateProcess (h, 1);
3561 }
3562 else if (sig == SIGINT)
3563 GenerateConsoleCtrlEvent (CTRL_C_EVENT, pid);
3564 else if (sig == SIGBREAK)
3565 GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid);
3566 /* ??? The last two alternatives don't really work. SIGBREAK requires setting
3567 up process groups at start time which we don't do; treating SIGINT is just
3568 not possible apparently. So we really only support signal 9. Fortunately
3569 that's all we use in GNAT.Expect */
3570
3571 CloseHandle (h);
3572 #elif defined (__vxworks)
3573 /* Not implemented */
3574 #else
3575 kill (pid, sig);
3576 #endif
3577 }
3578
__gnat_killprocesstree(int pid,int sig_num)3579 void __gnat_killprocesstree (int pid, int sig_num)
3580 {
3581 #if defined(_WIN32)
3582 PROCESSENTRY32 pe;
3583
3584 memset(&pe, 0, sizeof(PROCESSENTRY32));
3585 pe.dwSize = sizeof(PROCESSENTRY32);
3586
3587 HANDLE hSnap = CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS, 0);
3588
3589 /* cannot take snapshot, just kill the parent process */
3590
3591 if (hSnap == INVALID_HANDLE_VALUE)
3592 {
3593 __gnat_kill (pid, sig_num, 1);
3594 return;
3595 }
3596
3597 if (Process32First(hSnap, &pe))
3598 {
3599 BOOL bContinue = TRUE;
3600
3601 /* kill child processes first */
3602
3603 while (bContinue)
3604 {
3605 if (pe.th32ParentProcessID == (DWORD)pid)
3606 __gnat_killprocesstree (pe.th32ProcessID, sig_num);
3607
3608 bContinue = Process32Next (hSnap, &pe);
3609 }
3610 }
3611
3612 CloseHandle (hSnap);
3613
3614 /* kill process */
3615
3616 __gnat_kill (pid, sig_num, 1);
3617
3618 #elif defined (__vxworks)
3619 /* not implemented */
3620
3621 #elif defined (__linux__)
3622 DIR *dir;
3623 struct dirent *d;
3624
3625 /* read all processes' pid and ppid */
3626
3627 dir = opendir ("/proc");
3628
3629 /* cannot open proc, just kill the parent process */
3630
3631 if (!dir)
3632 {
3633 __gnat_kill (pid, sig_num, 1);
3634 return;
3635 }
3636
3637 /* kill child processes first */
3638
3639 while ((d = readdir (dir)) != NULL)
3640 {
3641 if ((d->d_type & DT_DIR) == DT_DIR)
3642 {
3643 char statfile[64];
3644 int _pid, _ppid;
3645
3646 /* read /proc/<PID>/stat */
3647
3648 if (strlen (d->d_name) >= sizeof (statfile) - strlen ("/proc//stat"))
3649 continue;
3650 strcpy (statfile, "/proc/");
3651 strcat (statfile, d->d_name);
3652 strcat (statfile, "/stat");
3653
3654 FILE *fd = fopen (statfile, "r");
3655
3656 if (fd)
3657 {
3658 const int match = fscanf (fd, "%d %*s %*s %d", &_pid, &_ppid);
3659 fclose (fd);
3660
3661 if (match == 2 && _ppid == pid)
3662 __gnat_killprocesstree (_pid, sig_num);
3663 }
3664 }
3665 }
3666
3667 closedir (dir);
3668
3669 /* kill process */
3670
3671 __gnat_kill (pid, sig_num, 1);
3672 #else
3673 __gnat_kill (pid, sig_num, 1);
3674 #endif
3675 /* Note on Solaris it is possible to read /proc/<PID>/status.
3676 The 5th and 6th words are the pid and the 7th and 8th the ppid.
3677 See: /usr/include/sys/procfs.h (struct pstatus).
3678 */
3679 }
3680
3681 #ifdef __cplusplus
3682 }
3683 #endif
3684