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