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