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