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