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