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 (__linux__) || defined (__FreeBSD__) || defined (__NetBSD__) \
1161 || defined (__OpenBSD__) || defined (__GLIBC__) || defined (__ANDROID__) \
1162 || defined (__DragonFly__)
1163 #define MAX_SAFE_PATH 1000
1164 char *tmpdir = getenv ("TMPDIR");
1165
1166 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1167 a buffer overflow. */
1168 if (tmpdir == NULL || strlen (tmpdir) > MAX_SAFE_PATH)
1169 #ifdef __ANDROID__
1170 strcpy (tmp_filename, "/cache/gnat-XXXXXX");
1171 #else
1172 strcpy (tmp_filename, "/tmp/gnat-XXXXXX");
1173 #endif
1174 else
1175 sprintf (tmp_filename, "%s/gnat-XXXXXX", tmpdir);
1176
1177 close (mkstemp(tmp_filename));
1178 #elif defined (__vxworks) && !defined (VTHREADS)
1179 int index;
1180 char *pos;
1181 char *savepos;
1182 static ushort_t seed = 0; /* used to generate unique name */
1183
1184 /* Generate a unique name. */
1185 strcpy (tmp_filename, "tmp");
1186
1187 index = 5;
1188 savepos = pos = tmp_filename + strlen (tmp_filename) + index;
1189 *pos = '\0';
1190
1191 while (1)
1192 {
1193 FILE *f;
1194 ushort_t t;
1195
1196 /* Fill up the name buffer from the last position. */
1197 seed++;
1198 for (t = seed; 0 <= --index; t >>= 3)
1199 *--pos = '0' + (t & 07);
1200
1201 /* Check to see if its unique, if not bump the seed and try again. */
1202 f = fopen (tmp_filename, "r");
1203 if (f == NULL)
1204 break;
1205 fclose (f);
1206 pos = savepos;
1207 index = 5;
1208 }
1209 #else
1210 tmpnam (tmp_filename);
1211 #endif
1212 }
1213
1214 /* Open directory and returns a DIR pointer. */
1215
__gnat_opendir(char * name)1216 DIR* __gnat_opendir (char *name)
1217 {
1218 #if defined (__MINGW32__)
1219 TCHAR wname[GNAT_MAX_PATH_LEN];
1220
1221 S2WSC (wname, name, GNAT_MAX_PATH_LEN);
1222 return (DIR*)_topendir (wname);
1223
1224 #else
1225 return opendir (name);
1226 #endif
1227 }
1228
1229 /* Read the next entry in a directory. The returned string points somewhere
1230 in the buffer. */
1231
1232 #if defined (__sun__)
1233 /* For Solaris, be sure to use the 64-bit version, otherwise NFS reads may
1234 fail with EOVERFLOW if the server uses 64-bit cookies. */
1235 #define dirent dirent64
1236 #define readdir readdir64
1237 #endif
1238
1239 char *
__gnat_readdir(DIR * dirp,char * buffer,int * len)1240 __gnat_readdir (DIR *dirp, char *buffer, int *len)
1241 {
1242 #if defined (__MINGW32__)
1243 struct _tdirent *dirent = _treaddir ((_TDIR*)dirp);
1244
1245 if (dirent != NULL)
1246 {
1247 WS2SC (buffer, dirent->d_name, GNAT_MAX_PATH_LEN);
1248 *len = strlen (buffer);
1249
1250 return buffer;
1251 }
1252 else
1253 return NULL;
1254
1255 #elif defined (HAVE_READDIR_R)
1256 /* If possible, try to use the thread-safe version. */
1257 if (readdir_r (dirp, buffer) != NULL)
1258 {
1259 *len = strlen (((struct dirent*) buffer)->d_name);
1260 return ((struct dirent*) buffer)->d_name;
1261 }
1262 else
1263 return NULL;
1264
1265 #else
1266 struct dirent *dirent = (struct dirent *) readdir (dirp);
1267
1268 if (dirent != NULL)
1269 {
1270 strcpy (buffer, dirent->d_name);
1271 *len = strlen (buffer);
1272 return buffer;
1273 }
1274 else
1275 return NULL;
1276
1277 #endif
1278 }
1279
1280 /* Close a directory entry. */
1281
__gnat_closedir(DIR * dirp)1282 int __gnat_closedir (DIR *dirp)
1283 {
1284 #if defined (__MINGW32__)
1285 return _tclosedir ((_TDIR*)dirp);
1286
1287 #else
1288 return closedir (dirp);
1289 #endif
1290 }
1291
1292 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1293
1294 int
__gnat_readdir_is_thread_safe(void)1295 __gnat_readdir_is_thread_safe (void)
1296 {
1297 #ifdef HAVE_READDIR_R
1298 return 1;
1299 #else
1300 return 0;
1301 #endif
1302 }
1303
1304 #if defined (_WIN32)
1305 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1306 static const unsigned long long w32_epoch_offset = 11644473600ULL;
1307
1308 /* Returns the file modification timestamp using Win32 routines which are
1309 immune against daylight saving time change. It is in fact not possible to
1310 use fstat for this purpose as the DST modify the st_mtime field of the
1311 stat structure. */
1312
1313 static time_t
win32_filetime(HANDLE h)1314 win32_filetime (HANDLE h)
1315 {
1316 union
1317 {
1318 FILETIME ft_time;
1319 unsigned long long ull_time;
1320 } t_write;
1321
1322 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1323 since <Jan 1st 1601>. This function must return the number of seconds
1324 since <Jan 1st 1970>. */
1325
1326 if (GetFileTime (h, NULL, NULL, &t_write.ft_time))
1327 return (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
1328 return (time_t) 0;
1329 }
1330
1331 /* As above but starting from a FILETIME. */
1332 static void
f2t(const FILETIME * ft,__time64_t * t)1333 f2t (const FILETIME *ft, __time64_t *t)
1334 {
1335 union
1336 {
1337 FILETIME ft_time;
1338 unsigned long long ull_time;
1339 } t_write;
1340
1341 t_write.ft_time = *ft;
1342 *t = (__time64_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
1343 }
1344 #endif
1345
1346 /* Return a GNAT time stamp given a file name. */
1347
1348 OS_Time
__gnat_file_time_name_attr(char * name,struct file_attributes * attr)1349 __gnat_file_time_name_attr (char* name, struct file_attributes* attr)
1350 {
1351 if (attr->timestamp == (OS_Time)-2) {
1352 #if defined (_WIN32)
1353 BOOL res;
1354 WIN32_FILE_ATTRIBUTE_DATA fad;
1355 __time64_t ret = -1;
1356 TCHAR wname[GNAT_MAX_PATH_LEN];
1357 S2WSC (wname, name, GNAT_MAX_PATH_LEN);
1358
1359 if ((res = GetFileAttributesEx (wname, GetFileExInfoStandard, &fad)))
1360 f2t (&fad.ftLastWriteTime, &ret);
1361 attr->timestamp = (OS_Time) ret;
1362 #else
1363 __gnat_stat_to_attr (-1, name, attr);
1364 #endif
1365 }
1366 return attr->timestamp;
1367 }
1368
1369 OS_Time
__gnat_file_time_name(char * name)1370 __gnat_file_time_name (char *name)
1371 {
1372 struct file_attributes attr;
1373 __gnat_reset_attributes (&attr);
1374 return __gnat_file_time_name_attr (name, &attr);
1375 }
1376
1377 /* Return a GNAT time stamp given a file descriptor. */
1378
1379 OS_Time
__gnat_file_time_fd_attr(int fd,struct file_attributes * attr)1380 __gnat_file_time_fd_attr (int fd, struct file_attributes* attr)
1381 {
1382 if (attr->timestamp == (OS_Time)-2) {
1383 #if defined (_WIN32)
1384 HANDLE h = (HANDLE) _get_osfhandle (fd);
1385 time_t ret = win32_filetime (h);
1386 attr->timestamp = (OS_Time) ret;
1387
1388 #else
1389 __gnat_stat_to_attr (fd, NULL, attr);
1390 #endif
1391 }
1392
1393 return attr->timestamp;
1394 }
1395
1396 OS_Time
__gnat_file_time_fd(int fd)1397 __gnat_file_time_fd (int fd)
1398 {
1399 struct file_attributes attr;
1400 __gnat_reset_attributes (&attr);
1401 return __gnat_file_time_fd_attr (fd, &attr);
1402 }
1403
1404 /* Set the file time stamp. */
1405
1406 void
__gnat_set_file_time_name(char * name,time_t time_stamp)1407 __gnat_set_file_time_name (char *name, time_t time_stamp)
1408 {
1409 #if defined (__vxworks)
1410
1411 /* Code to implement __gnat_set_file_time_name for these systems. */
1412
1413 #elif defined (_WIN32)
1414 union
1415 {
1416 FILETIME ft_time;
1417 unsigned long long ull_time;
1418 } t_write;
1419 TCHAR wname[GNAT_MAX_PATH_LEN];
1420
1421 S2WSC (wname, name, GNAT_MAX_PATH_LEN);
1422
1423 HANDLE h = CreateFile
1424 (wname, GENERIC_WRITE, FILE_SHARE_WRITE, NULL,
1425 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS,
1426 NULL);
1427 if (h == INVALID_HANDLE_VALUE)
1428 return;
1429 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1430 t_write.ull_time = ((unsigned long long)time_stamp + w32_epoch_offset);
1431 /* Convert to 100 nanosecond units */
1432 t_write.ull_time *= 10000000ULL;
1433
1434 SetFileTime(h, NULL, NULL, &t_write.ft_time);
1435 CloseHandle (h);
1436 return;
1437
1438 #else
1439 struct utimbuf utimbuf;
1440 time_t t;
1441
1442 /* Set modification time to requested time. */
1443 utimbuf.modtime = time_stamp;
1444
1445 /* Set access time to now in local time. */
1446 t = time ((time_t) 0);
1447 utimbuf.actime = mktime (localtime (&t));
1448
1449 utime (name, &utimbuf);
1450 #endif
1451 }
1452
1453 /* Get the list of installed standard libraries from the
1454 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1455 key. */
1456
1457 char *
__gnat_get_libraries_from_registry(void)1458 __gnat_get_libraries_from_registry (void)
1459 {
1460 char *result = (char *) xmalloc (1);
1461
1462 result[0] = '\0';
1463
1464 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
1465
1466 HKEY reg_key;
1467 DWORD name_size, value_size;
1468 char name[256];
1469 char value[256];
1470 DWORD type;
1471 DWORD index;
1472 LONG res;
1473
1474 /* First open the key. */
1475 res = RegOpenKeyExA (HKEY_LOCAL_MACHINE, "SOFTWARE", 0, KEY_READ, ®_key);
1476
1477 if (res == ERROR_SUCCESS)
1478 res = RegOpenKeyExA (reg_key, "Ada Core Technologies", 0,
1479 KEY_READ, ®_key);
1480
1481 if (res == ERROR_SUCCESS)
1482 res = RegOpenKeyExA (reg_key, "GNAT", 0, KEY_READ, ®_key);
1483
1484 if (res == ERROR_SUCCESS)
1485 res = RegOpenKeyExA (reg_key, "Standard Libraries", 0, KEY_READ, ®_key);
1486
1487 /* If the key exists, read out all the values in it and concatenate them
1488 into a path. */
1489 for (index = 0; res == ERROR_SUCCESS; index++)
1490 {
1491 value_size = name_size = 256;
1492 res = RegEnumValueA (reg_key, index, name, &name_size, 0,
1493 &type, (LPBYTE)value, &value_size);
1494
1495 if (res == ERROR_SUCCESS && type == REG_SZ)
1496 {
1497 char *old_result = result;
1498
1499 result = (char *) xmalloc (strlen (old_result) + value_size + 2);
1500 strcpy (result, old_result);
1501 strcat (result, value);
1502 strcat (result, ";");
1503 free (old_result);
1504 }
1505 }
1506
1507 /* Remove the trailing ";". */
1508 if (result[0] != 0)
1509 result[strlen (result) - 1] = 0;
1510
1511 #endif
1512 return result;
1513 }
1514
1515 /* Query information for the given file NAME and return it in STATBUF.
1516 * Returns 0 for success, or errno value for failure.
1517 */
1518 int
__gnat_stat(char * name,GNAT_STRUCT_STAT * statbuf)1519 __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
1520 {
1521 #ifdef __MINGW32__
1522 WIN32_FILE_ATTRIBUTE_DATA fad;
1523 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
1524 int name_len;
1525 BOOL res;
1526 DWORD error;
1527
1528 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
1529 name_len = _tcslen (wname);
1530
1531 if (name_len > GNAT_MAX_PATH_LEN)
1532 return EINVAL;
1533
1534 ZeroMemory (statbuf, sizeof(GNAT_STRUCT_STAT));
1535
1536 res = GetFileAttributesEx (wname, GetFileExInfoStandard, &fad);
1537
1538 if (res == FALSE) {
1539 error = GetLastError();
1540
1541 /* Check file existence using GetFileAttributes() which does not fail on
1542 special Windows files like con:, aux:, nul: etc... */
1543
1544 if (GetFileAttributes(wname) != INVALID_FILE_ATTRIBUTES) {
1545 /* Just pretend that it is a regular and readable file */
1546 statbuf->st_mode = S_IFREG | S_IREAD | S_IWRITE;
1547 return 0;
1548 }
1549
1550 switch (error) {
1551 case ERROR_ACCESS_DENIED:
1552 case ERROR_SHARING_VIOLATION:
1553 case ERROR_LOCK_VIOLATION:
1554 case ERROR_SHARING_BUFFER_EXCEEDED:
1555 return EACCES;
1556 case ERROR_BUFFER_OVERFLOW:
1557 return ENAMETOOLONG;
1558 case ERROR_NOT_ENOUGH_MEMORY:
1559 return ENOMEM;
1560 default:
1561 return ENOENT;
1562 }
1563 }
1564
1565 f2t (&fad.ftCreationTime, &statbuf->st_ctime);
1566 f2t (&fad.ftLastWriteTime, &statbuf->st_mtime);
1567 f2t (&fad.ftLastAccessTime, &statbuf->st_atime);
1568
1569 statbuf->st_size =
1570 (__int64)fad.nFileSizeLow | (__int64)fad.nFileSizeHigh << 32;
1571
1572 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1573 statbuf->st_mode = S_IREAD;
1574
1575 if (fad.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)
1576 statbuf->st_mode |= S_IFDIR;
1577 else
1578 statbuf->st_mode |= S_IFREG;
1579
1580 if (!(fad.dwFileAttributes & FILE_ATTRIBUTE_READONLY))
1581 statbuf->st_mode |= S_IWRITE;
1582
1583 return 0;
1584
1585 #else
1586 return GNAT_STAT (name, statbuf) == 0 ? 0 : errno;
1587 #endif
1588 }
1589
1590 /*************************************************************************
1591 ** Check whether a file exists
1592 *************************************************************************/
1593
1594 int
__gnat_file_exists_attr(char * name,struct file_attributes * attr)1595 __gnat_file_exists_attr (char* name, struct file_attributes* attr)
1596 {
1597 if (attr->exists == ATTR_UNSET)
1598 __gnat_stat_to_attr (-1, name, attr);
1599
1600 return attr->exists;
1601 }
1602
1603 int
__gnat_file_exists(char * name)1604 __gnat_file_exists (char *name)
1605 {
1606 struct file_attributes attr;
1607 __gnat_reset_attributes (&attr);
1608 return __gnat_file_exists_attr (name, &attr);
1609 }
1610
1611 /**********************************************************************
1612 ** Whether name is an absolute path
1613 **********************************************************************/
1614
1615 int
__gnat_is_absolute_path(char * name,int length)1616 __gnat_is_absolute_path (char *name, int length)
1617 {
1618 #ifdef __vxworks
1619 /* On VxWorks systems, an absolute path can be represented (depending on
1620 the host platform) as either /dir/file, or device:/dir/file, or
1621 device:drive_letter:/dir/file. */
1622
1623 int index;
1624
1625 if (name[0] == '/')
1626 return 1;
1627
1628 for (index = 0; index < length; index++)
1629 {
1630 if (name[index] == ':' &&
1631 ((name[index + 1] == '/') ||
1632 (isalpha (name[index + 1]) && index + 2 <= length &&
1633 name[index + 2] == '/')))
1634 return 1;
1635
1636 else if (name[index] == '/')
1637 return 0;
1638 }
1639 return 0;
1640 #else
1641 return (length != 0) &&
1642 (*name == '/' || *name == DIR_SEPARATOR
1643 #if defined (WINNT)
1644 || (length > 1 && ISALPHA (name[0]) && name[1] == ':')
1645 #endif
1646 );
1647 #endif
1648 }
1649
1650 int
__gnat_is_regular_file_attr(char * name,struct file_attributes * attr)1651 __gnat_is_regular_file_attr (char* name, struct file_attributes* attr)
1652 {
1653 if (attr->regular == ATTR_UNSET)
1654 __gnat_stat_to_attr (-1, name, attr);
1655
1656 return attr->regular;
1657 }
1658
1659 int
__gnat_is_regular_file(char * name)1660 __gnat_is_regular_file (char *name)
1661 {
1662 struct file_attributes attr;
1663
1664 __gnat_reset_attributes (&attr);
1665 return __gnat_is_regular_file_attr (name, &attr);
1666 }
1667
1668 int
__gnat_is_regular_file_fd(int fd)1669 __gnat_is_regular_file_fd (int fd)
1670 {
1671 int ret;
1672 GNAT_STRUCT_STAT statbuf;
1673
1674 ret = GNAT_FSTAT (fd, &statbuf);
1675 return (!ret && S_ISREG (statbuf.st_mode));
1676 }
1677
1678 int
__gnat_is_directory_attr(char * name,struct file_attributes * attr)1679 __gnat_is_directory_attr (char* name, struct file_attributes* attr)
1680 {
1681 if (attr->directory == ATTR_UNSET)
1682 __gnat_stat_to_attr (-1, name, attr);
1683
1684 return attr->directory;
1685 }
1686
1687 int
__gnat_is_directory(char * name)1688 __gnat_is_directory (char *name)
1689 {
1690 struct file_attributes attr;
1691
1692 __gnat_reset_attributes (&attr);
1693 return __gnat_is_directory_attr (name, &attr);
1694 }
1695
1696 #if defined (_WIN32)
1697
1698 /* Returns the same constant as GetDriveType but takes a pathname as
1699 argument. */
1700
1701 static UINT
GetDriveTypeFromPath(TCHAR * wfullpath)1702 GetDriveTypeFromPath (TCHAR *wfullpath)
1703 {
1704 TCHAR wdrv[MAX_PATH];
1705 TCHAR wpath[MAX_PATH];
1706 TCHAR wfilename[MAX_PATH];
1707 TCHAR wext[MAX_PATH];
1708
1709 _tsplitpath (wfullpath, wdrv, wpath, wfilename, wext);
1710
1711 if (_tcslen (wdrv) != 0)
1712 {
1713 /* we have a drive specified. */
1714 _tcscat (wdrv, _T("\\"));
1715 return GetDriveType (wdrv);
1716 }
1717 else
1718 {
1719 /* No drive specified. */
1720
1721 /* Is this a relative path, if so get current drive type. */
1722 if (wpath[0] != _T('\\') ||
1723 (_tcslen (wpath) > 2 && wpath[0] == _T('\\')
1724 && wpath[1] != _T('\\')))
1725 return GetDriveType (NULL);
1726
1727 UINT result = GetDriveType (wpath);
1728
1729 /* Cannot guess the drive type, is this \\.\ ? */
1730
1731 if (result == DRIVE_NO_ROOT_DIR &&
1732 _tcslen (wpath) >= 4 && wpath[0] == _T('\\') && wpath[1] == _T('\\')
1733 && wpath[2] == _T('.') && wpath[3] == _T('\\'))
1734 {
1735 if (_tcslen (wpath) == 4)
1736 _tcscat (wpath, wfilename);
1737
1738 LPTSTR p = &wpath[4];
1739 LPTSTR b = _tcschr (p, _T('\\'));
1740
1741 if (b != NULL)
1742 {
1743 /* logical drive \\.\c\dir\file */
1744 *b++ = _T(':');
1745 *b++ = _T('\\');
1746 *b = _T('\0');
1747 }
1748 else
1749 _tcscat (p, _T(":\\"));
1750
1751 return GetDriveType (p);
1752 }
1753
1754 return result;
1755 }
1756 }
1757
1758 /* This MingW section contains code to work with ACL. */
1759 static int
__gnat_check_OWNER_ACL(TCHAR * wname,DWORD CheckAccessDesired,GENERIC_MAPPING CheckGenericMapping)1760 __gnat_check_OWNER_ACL (TCHAR *wname,
1761 DWORD CheckAccessDesired,
1762 GENERIC_MAPPING CheckGenericMapping)
1763 {
1764 DWORD dwAccessDesired, dwAccessAllowed;
1765 PRIVILEGE_SET PrivilegeSet;
1766 DWORD dwPrivSetSize = sizeof (PRIVILEGE_SET);
1767 BOOL fAccessGranted = FALSE;
1768 HANDLE hToken = NULL;
1769 DWORD nLength = 0;
1770 PSECURITY_DESCRIPTOR pSD = NULL;
1771
1772 GetFileSecurity
1773 (wname, OWNER_SECURITY_INFORMATION |
1774 GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION,
1775 NULL, 0, &nLength);
1776
1777 if ((pSD = (SECURITY_DESCRIPTOR *) HeapAlloc
1778 (GetProcessHeap (), HEAP_ZERO_MEMORY, nLength)) == NULL)
1779 return 0;
1780
1781 /* Obtain the security descriptor. */
1782
1783 if (!GetFileSecurity
1784 (wname, OWNER_SECURITY_INFORMATION |
1785 GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION,
1786 pSD, nLength, &nLength))
1787 goto error;
1788
1789 if (!ImpersonateSelf (SecurityImpersonation))
1790 goto error;
1791
1792 if (!OpenThreadToken
1793 (GetCurrentThread(), TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken))
1794 goto error;
1795
1796 /* Undoes the effect of ImpersonateSelf. */
1797
1798 RevertToSelf ();
1799
1800 /* We want to test for write permissions. */
1801
1802 dwAccessDesired = CheckAccessDesired;
1803
1804 MapGenericMask (&dwAccessDesired, &CheckGenericMapping);
1805
1806 if (!AccessCheck
1807 (pSD , /* security descriptor to check */
1808 hToken, /* impersonation token */
1809 dwAccessDesired, /* requested access rights */
1810 &CheckGenericMapping, /* pointer to GENERIC_MAPPING */
1811 &PrivilegeSet, /* receives privileges used in check */
1812 &dwPrivSetSize, /* size of PrivilegeSet buffer */
1813 &dwAccessAllowed, /* receives mask of allowed access rights */
1814 &fAccessGranted))
1815 goto error;
1816
1817 CloseHandle (hToken);
1818 HeapFree (GetProcessHeap (), 0, pSD);
1819 return fAccessGranted;
1820
1821 error:
1822 if (hToken)
1823 CloseHandle (hToken);
1824 HeapFree (GetProcessHeap (), 0, pSD);
1825 return 0;
1826 }
1827
1828 static void
__gnat_set_OWNER_ACL(TCHAR * wname,ACCESS_MODE AccessMode,DWORD AccessPermissions)1829 __gnat_set_OWNER_ACL (TCHAR *wname,
1830 ACCESS_MODE AccessMode,
1831 DWORD AccessPermissions)
1832 {
1833 PACL pOldDACL = NULL;
1834 PACL pNewDACL = NULL;
1835 PSECURITY_DESCRIPTOR pSD = NULL;
1836 EXPLICIT_ACCESS ea;
1837 TCHAR username [100];
1838 DWORD unsize = 100;
1839
1840 /* Get current user, he will act as the owner */
1841
1842 if (!GetUserName (username, &unsize))
1843 return;
1844
1845 if (GetNamedSecurityInfo
1846 (wname,
1847 SE_FILE_OBJECT,
1848 DACL_SECURITY_INFORMATION,
1849 NULL, NULL, &pOldDACL, NULL, &pSD) != ERROR_SUCCESS)
1850 return;
1851
1852 BuildExplicitAccessWithName
1853 (&ea, username, AccessPermissions, (ACCESS_MODE) AccessMode, NO_INHERITANCE);
1854
1855 if (AccessMode == SET_ACCESS)
1856 {
1857 /* SET_ACCESS, we want to set an explicte set of permissions, do not
1858 merge with current DACL. */
1859 if (SetEntriesInAcl (1, &ea, NULL, &pNewDACL) != ERROR_SUCCESS)
1860 return;
1861 }
1862 else
1863 if (SetEntriesInAcl (1, &ea, pOldDACL, &pNewDACL) != ERROR_SUCCESS)
1864 return;
1865
1866 if (SetNamedSecurityInfo
1867 (wname, SE_FILE_OBJECT,
1868 DACL_SECURITY_INFORMATION, NULL, NULL, pNewDACL, NULL) != ERROR_SUCCESS)
1869 return;
1870
1871 LocalFree (pSD);
1872 LocalFree (pNewDACL);
1873 }
1874
1875 /* Check if it is possible to use ACL for wname, the file must not be on a
1876 network drive. */
1877
1878 static int
__gnat_can_use_acl(TCHAR * wname)1879 __gnat_can_use_acl (TCHAR *wname)
1880 {
1881 return __gnat_use_acl && GetDriveTypeFromPath (wname) != DRIVE_REMOTE;
1882 }
1883
1884 #endif /* defined (_WIN32) */
1885
1886 int
__gnat_is_readable_file_attr(char * name,struct file_attributes * attr)1887 __gnat_is_readable_file_attr (char* name, struct file_attributes* attr)
1888 {
1889 if (attr->readable == ATTR_UNSET)
1890 {
1891 #if defined (_WIN32)
1892 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
1893 GENERIC_MAPPING GenericMapping;
1894
1895 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
1896
1897 if (__gnat_can_use_acl (wname))
1898 {
1899 ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
1900 GenericMapping.GenericRead = GENERIC_READ;
1901 attr->readable =
1902 __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
1903 }
1904 else
1905 attr->readable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
1906 #else
1907 __gnat_stat_to_attr (-1, name, attr);
1908 #endif
1909 }
1910
1911 return attr->readable;
1912 }
1913
1914 int
__gnat_is_readable_file(char * name)1915 __gnat_is_readable_file (char *name)
1916 {
1917 struct file_attributes attr;
1918
1919 __gnat_reset_attributes (&attr);
1920 return __gnat_is_readable_file_attr (name, &attr);
1921 }
1922
1923 int
__gnat_is_writable_file_attr(char * name,struct file_attributes * attr)1924 __gnat_is_writable_file_attr (char* name, struct file_attributes* attr)
1925 {
1926 if (attr->writable == ATTR_UNSET)
1927 {
1928 #if defined (_WIN32)
1929 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
1930 GENERIC_MAPPING GenericMapping;
1931
1932 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
1933
1934 if (__gnat_can_use_acl (wname))
1935 {
1936 ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
1937 GenericMapping.GenericWrite = GENERIC_WRITE;
1938
1939 attr->writable = __gnat_check_OWNER_ACL
1940 (wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
1941 && !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
1942 }
1943 else
1944 attr->writable =
1945 !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
1946
1947 #else
1948 __gnat_stat_to_attr (-1, name, attr);
1949 #endif
1950 }
1951
1952 return attr->writable;
1953 }
1954
1955 int
__gnat_is_writable_file(char * name)1956 __gnat_is_writable_file (char *name)
1957 {
1958 struct file_attributes attr;
1959
1960 __gnat_reset_attributes (&attr);
1961 return __gnat_is_writable_file_attr (name, &attr);
1962 }
1963
1964 int
__gnat_is_executable_file_attr(char * name,struct file_attributes * attr)1965 __gnat_is_executable_file_attr (char* name, struct file_attributes* attr)
1966 {
1967 if (attr->executable == 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.GenericExecute = GENERIC_EXECUTE;
1979
1980 attr->executable =
1981 __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
1982 }
1983 else
1984 {
1985 TCHAR *l, *last = _tcsstr(wname, _T(".exe"));
1986
1987 /* look for last .exe */
1988 if (last)
1989 while ((l = _tcsstr(last+1, _T(".exe"))))
1990 last = l;
1991
1992 attr->executable =
1993 GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
1994 && (last - wname) == (int) (_tcslen (wname) - 4);
1995 }
1996 #else
1997 __gnat_stat_to_attr (-1, name, attr);
1998 #endif
1999 }
2000
2001 return attr->regular && attr->executable;
2002 }
2003
2004 int
__gnat_is_executable_file(char * name)2005 __gnat_is_executable_file (char *name)
2006 {
2007 struct file_attributes attr;
2008
2009 __gnat_reset_attributes (&attr);
2010 return __gnat_is_executable_file_attr (name, &attr);
2011 }
2012
2013 void
__gnat_set_writable(char * name)2014 __gnat_set_writable (char *name)
2015 {
2016 #if defined (_WIN32)
2017 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2018
2019 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2020
2021 if (__gnat_can_use_acl (wname))
2022 __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_WRITE);
2023
2024 SetFileAttributes
2025 (wname, GetFileAttributes (wname) & ~FILE_ATTRIBUTE_READONLY);
2026 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2027 GNAT_STRUCT_STAT statbuf;
2028
2029 if (GNAT_STAT (name, &statbuf) == 0)
2030 {
2031 statbuf.st_mode = statbuf.st_mode | S_IWUSR;
2032 chmod (name, statbuf.st_mode);
2033 }
2034 #endif
2035 }
2036
2037 /* must match definition in s-os_lib.ads */
2038 #define S_OWNER 1
2039 #define S_GROUP 2
2040 #define S_OTHERS 4
2041
2042 void
__gnat_set_executable(char * name,int mode ATTRIBUTE_UNUSED)2043 __gnat_set_executable (char *name, int mode ATTRIBUTE_UNUSED)
2044 {
2045 #if defined (_WIN32)
2046 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2047
2048 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2049
2050 if (__gnat_can_use_acl (wname))
2051 __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE);
2052
2053 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2054 GNAT_STRUCT_STAT statbuf;
2055
2056 if (GNAT_STAT (name, &statbuf) == 0)
2057 {
2058 if (mode & S_OWNER)
2059 statbuf.st_mode = statbuf.st_mode | S_IXUSR;
2060 if (mode & S_GROUP)
2061 statbuf.st_mode = statbuf.st_mode | S_IXGRP;
2062 if (mode & S_OTHERS)
2063 statbuf.st_mode = statbuf.st_mode | S_IXOTH;
2064 chmod (name, statbuf.st_mode);
2065 }
2066 #endif
2067 }
2068
2069 void
__gnat_set_non_writable(char * name)2070 __gnat_set_non_writable (char *name)
2071 {
2072 #if defined (_WIN32)
2073 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2074
2075 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2076
2077 if (__gnat_can_use_acl (wname))
2078 __gnat_set_OWNER_ACL
2079 (wname, DENY_ACCESS,
2080 FILE_WRITE_DATA | FILE_APPEND_DATA |
2081 FILE_WRITE_EA | FILE_WRITE_ATTRIBUTES);
2082
2083 SetFileAttributes
2084 (wname, GetFileAttributes (wname) | FILE_ATTRIBUTE_READONLY);
2085 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2086 GNAT_STRUCT_STAT statbuf;
2087
2088 if (GNAT_STAT (name, &statbuf) == 0)
2089 {
2090 statbuf.st_mode = statbuf.st_mode & 07577;
2091 chmod (name, statbuf.st_mode);
2092 }
2093 #endif
2094 }
2095
2096 void
__gnat_set_readable(char * name)2097 __gnat_set_readable (char *name)
2098 {
2099 #if defined (_WIN32)
2100 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2101
2102 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2103
2104 if (__gnat_can_use_acl (wname))
2105 __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ);
2106
2107 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2108 GNAT_STRUCT_STAT statbuf;
2109
2110 if (GNAT_STAT (name, &statbuf) == 0)
2111 {
2112 chmod (name, statbuf.st_mode | S_IREAD);
2113 }
2114 #endif
2115 }
2116
2117 void
__gnat_set_non_readable(char * name)2118 __gnat_set_non_readable (char *name)
2119 {
2120 #if defined (_WIN32)
2121 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2122
2123 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2124
2125 if (__gnat_can_use_acl (wname))
2126 __gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ);
2127
2128 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2129 GNAT_STRUCT_STAT statbuf;
2130
2131 if (GNAT_STAT (name, &statbuf) == 0)
2132 {
2133 chmod (name, statbuf.st_mode & (~S_IREAD));
2134 }
2135 #endif
2136 }
2137
2138 int
__gnat_is_symbolic_link_attr(char * name ATTRIBUTE_UNUSED,struct file_attributes * attr)2139 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED,
2140 struct file_attributes* attr)
2141 {
2142 if (attr->symbolic_link == ATTR_UNSET)
2143 {
2144 #if defined (__vxworks)
2145 attr->symbolic_link = 0;
2146
2147 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2148 int ret;
2149 GNAT_STRUCT_STAT statbuf;
2150 ret = GNAT_LSTAT (name, &statbuf);
2151 attr->symbolic_link = (!ret && S_ISLNK (statbuf.st_mode));
2152 #else
2153 attr->symbolic_link = 0;
2154 #endif
2155 }
2156 return attr->symbolic_link;
2157 }
2158
2159 int
__gnat_is_symbolic_link(char * name ATTRIBUTE_UNUSED)2160 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
2161 {
2162 struct file_attributes attr;
2163
2164 __gnat_reset_attributes (&attr);
2165 return __gnat_is_symbolic_link_attr (name, &attr);
2166 }
2167
2168 #if defined (__sun__)
2169 /* Using fork on Solaris will duplicate all the threads. fork1, which
2170 duplicates only the active thread, must be used instead, or spawning
2171 subprocess from a program with tasking will lead into numerous problems. */
2172 #define fork fork1
2173 #endif
2174
2175 int
__gnat_portable_spawn(char * args[]ATTRIBUTE_UNUSED)2176 __gnat_portable_spawn (char *args[] ATTRIBUTE_UNUSED)
2177 {
2178 int status ATTRIBUTE_UNUSED = 0;
2179 int finished ATTRIBUTE_UNUSED;
2180 int pid ATTRIBUTE_UNUSED;
2181
2182 #if defined (__vxworks) || defined(__PikeOS__)
2183 return -1;
2184
2185 #elif defined (_WIN32)
2186 /* args[0] must be quotes as it could contain a full pathname with spaces */
2187 char *args_0 = args[0];
2188 args[0] = (char *)xmalloc (strlen (args_0) + 3);
2189 strcpy (args[0], "\"");
2190 strcat (args[0], args_0);
2191 strcat (args[0], "\"");
2192
2193 status = spawnvp (P_WAIT, args_0, (char ** const)args);
2194
2195 /* restore previous value */
2196 free (args[0]);
2197 args[0] = (char *)args_0;
2198
2199 if (status < 0)
2200 return -1;
2201 else
2202 return status;
2203
2204 #else
2205
2206 pid = fork ();
2207 if (pid < 0)
2208 return -1;
2209
2210 if (pid == 0)
2211 {
2212 /* The child. */
2213 if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
2214 _exit (1);
2215 }
2216
2217 /* The parent. */
2218 finished = waitpid (pid, &status, 0);
2219
2220 if (finished != pid || WIFEXITED (status) == 0)
2221 return -1;
2222
2223 return WEXITSTATUS (status);
2224 #endif
2225
2226 return 0;
2227 }
2228
2229 /* Create a copy of the given file descriptor.
2230 Return -1 if an error occurred. */
2231
2232 int
__gnat_dup(int oldfd)2233 __gnat_dup (int oldfd)
2234 {
2235 #if defined (__vxworks) && !defined (__RTP__)
2236 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2237 RTPs. */
2238 return -1;
2239 #else
2240 return dup (oldfd);
2241 #endif
2242 }
2243
2244 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2245 Return -1 if an error occurred. */
2246
2247 int
__gnat_dup2(int oldfd ATTRIBUTE_UNUSED,int newfd ATTRIBUTE_UNUSED)2248 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED, int newfd ATTRIBUTE_UNUSED)
2249 {
2250 #if defined (__vxworks) && !defined (__RTP__)
2251 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2252 RTPs. */
2253 return -1;
2254 #elif defined (__PikeOS__)
2255 /* Not supported. */
2256 return -1;
2257 #elif defined (_WIN32)
2258 /* Special case when oldfd and newfd are identical and are the standard
2259 input, output or error as this makes Windows XP hangs. Note that we
2260 do that only for standard file descriptors that are known to be valid. */
2261 if (oldfd == newfd && newfd >= 0 && newfd <= 2)
2262 return newfd;
2263 else
2264 return dup2 (oldfd, newfd);
2265 #else
2266 return dup2 (oldfd, newfd);
2267 #endif
2268 }
2269
2270 int
__gnat_number_of_cpus(void)2271 __gnat_number_of_cpus (void)
2272 {
2273 int cores = 1;
2274
2275 #if defined (__linux__) || defined (__sun__) || defined (_AIX) \
2276 || defined (__APPLE__) || defined (__FreeBSD__) || defined (__OpenBSD__) \
2277 || defined (__DragonFly__) || defined (__NetBSD__)
2278 cores = (int) sysconf (_SC_NPROCESSORS_ONLN);
2279
2280 #elif defined (__hpux__)
2281 struct pst_dynamic psd;
2282 if (pstat_getdynamic (&psd, sizeof (psd), 1, 0) != -1)
2283 cores = (int) psd.psd_proc_cnt;
2284
2285 #elif defined (_WIN32)
2286 SYSTEM_INFO sysinfo;
2287 GetSystemInfo (&sysinfo);
2288 cores = (int) sysinfo.dwNumberOfProcessors;
2289
2290 #elif defined (_WRS_CONFIG_SMP)
2291 unsigned int vxCpuConfiguredGet (void);
2292
2293 cores = vxCpuConfiguredGet ();
2294
2295 #endif
2296
2297 return cores;
2298 }
2299
2300 /* WIN32 code to implement a wait call that wait for any child process. */
2301
2302 #if defined (_WIN32)
2303
2304 /* Synchronization code, to be thread safe. */
2305
2306 #ifdef CERT
2307
2308 /* For the Cert run times on native Windows we use dummy functions
2309 for locking and unlocking tasks since we do not support multiple
2310 threads on this configuration (Cert run time on native Windows). */
2311
EnterCS(void)2312 static void EnterCS (void) {}
LeaveCS(void)2313 static void LeaveCS (void) {}
SignalListChanged(void)2314 static void SignalListChanged (void) {}
2315
2316 #else
2317
2318 CRITICAL_SECTION ProcListCS;
2319 HANDLE ProcListEvt = NULL;
2320
EnterCS(void)2321 static void EnterCS (void)
2322 {
2323 EnterCriticalSection(&ProcListCS);
2324 }
2325
LeaveCS(void)2326 static void LeaveCS (void)
2327 {
2328 LeaveCriticalSection(&ProcListCS);
2329 }
2330
SignalListChanged(void)2331 static void SignalListChanged (void)
2332 {
2333 SetEvent (ProcListEvt);
2334 }
2335
2336 #endif
2337
2338 static HANDLE *HANDLES_LIST = NULL;
2339 static int *PID_LIST = NULL, plist_length = 0, plist_max_length = 0;
2340
2341 static void
add_handle(HANDLE h,int pid)2342 add_handle (HANDLE h, int pid)
2343 {
2344 /* -------------------- critical section -------------------- */
2345 EnterCS();
2346
2347 if (plist_length == plist_max_length)
2348 {
2349 plist_max_length += 100;
2350 HANDLES_LIST =
2351 (HANDLE *) xrealloc (HANDLES_LIST, sizeof (HANDLE) * plist_max_length);
2352 PID_LIST =
2353 (int *) xrealloc (PID_LIST, sizeof (int) * plist_max_length);
2354 }
2355
2356 HANDLES_LIST[plist_length] = h;
2357 PID_LIST[plist_length] = pid;
2358 ++plist_length;
2359
2360 SignalListChanged();
2361 LeaveCS();
2362 /* -------------------- critical section -------------------- */
2363 }
2364
2365 int
__gnat_win32_remove_handle(HANDLE h,int pid)2366 __gnat_win32_remove_handle (HANDLE h, int pid)
2367 {
2368 int j;
2369 int found = 0;
2370
2371 /* -------------------- critical section -------------------- */
2372 EnterCS();
2373
2374 for (j = 0; j < plist_length; j++)
2375 {
2376 if ((HANDLES_LIST[j] == h) || (PID_LIST[j] == pid))
2377 {
2378 CloseHandle (h);
2379 --plist_length;
2380 HANDLES_LIST[j] = HANDLES_LIST[plist_length];
2381 PID_LIST[j] = PID_LIST[plist_length];
2382 found = 1;
2383 break;
2384 }
2385 }
2386
2387 LeaveCS();
2388 /* -------------------- critical section -------------------- */
2389
2390 if (found)
2391 SignalListChanged();
2392
2393 return found;
2394 }
2395
2396 static void
win32_no_block_spawn(char * command,char * args[],HANDLE * h,int * pid)2397 win32_no_block_spawn (char *command, char *args[], HANDLE *h, int *pid)
2398 {
2399 BOOL result;
2400 STARTUPINFO SI;
2401 PROCESS_INFORMATION PI;
2402 SECURITY_ATTRIBUTES SA;
2403 int csize = 1;
2404 char *full_command;
2405 int k;
2406
2407 /* compute the total command line length */
2408 k = 0;
2409 while (args[k])
2410 {
2411 csize += strlen (args[k]) + 1;
2412 k++;
2413 }
2414
2415 full_command = (char *) xmalloc (csize);
2416
2417 /* Startup info. */
2418 SI.cb = sizeof (STARTUPINFO);
2419 SI.lpReserved = NULL;
2420 SI.lpReserved2 = NULL;
2421 SI.lpDesktop = NULL;
2422 SI.cbReserved2 = 0;
2423 SI.lpTitle = NULL;
2424 SI.dwFlags = 0;
2425 SI.wShowWindow = SW_HIDE;
2426
2427 /* Security attributes. */
2428 SA.nLength = sizeof (SECURITY_ATTRIBUTES);
2429 SA.bInheritHandle = TRUE;
2430 SA.lpSecurityDescriptor = NULL;
2431
2432 /* Prepare the command string. */
2433 strcpy (full_command, command);
2434 strcat (full_command, " ");
2435
2436 k = 1;
2437 while (args[k])
2438 {
2439 strcat (full_command, args[k]);
2440 strcat (full_command, " ");
2441 k++;
2442 }
2443
2444 {
2445 int wsize = csize * 2;
2446 TCHAR *wcommand = (TCHAR *) xmalloc (wsize);
2447
2448 S2WSC (wcommand, full_command, wsize);
2449
2450 free (full_command);
2451
2452 result = CreateProcess
2453 (NULL, wcommand, &SA, NULL, TRUE,
2454 GetPriorityClass (GetCurrentProcess()), NULL, NULL, &SI, &PI);
2455
2456 free (wcommand);
2457 }
2458
2459 if (result == TRUE)
2460 {
2461 CloseHandle (PI.hThread);
2462 *h = PI.hProcess;
2463 *pid = PI.dwProcessId;
2464 }
2465 else
2466 {
2467 *h = NULL;
2468 *pid = 0;
2469 }
2470 }
2471
2472 static int
win32_wait(int * status)2473 win32_wait (int *status)
2474 {
2475 DWORD exitcode, pid;
2476 HANDLE *hl;
2477 HANDLE h;
2478 int *pidl;
2479 DWORD res;
2480 int hl_len;
2481 int found;
2482
2483 START_WAIT:
2484
2485 if (plist_length == 0)
2486 {
2487 errno = ECHILD;
2488 return -1;
2489 }
2490
2491 /* -------------------- critical section -------------------- */
2492 EnterCS();
2493
2494 hl_len = plist_length;
2495
2496 #ifdef CERT
2497 hl = (HANDLE *) xmalloc (sizeof (HANDLE) * hl_len);
2498 memmove (hl, HANDLES_LIST, sizeof (HANDLE) * hl_len);
2499 pidl = (int *) xmalloc (sizeof (int) * hl_len);
2500 memmove (pidl, PID_LIST, sizeof (int) * hl_len);
2501 #else
2502 /* Note that index 0 contains the event handle that is signaled when the
2503 process list has changed */
2504 hl = (HANDLE *) xmalloc (sizeof (HANDLE) * hl_len + 1);
2505 hl[0] = ProcListEvt;
2506 memmove (&hl[1], HANDLES_LIST, sizeof (HANDLE) * hl_len);
2507 pidl = (int *) xmalloc (sizeof (int) * hl_len + 1);
2508 memmove (&pidl[1], PID_LIST, sizeof (int) * hl_len);
2509 hl_len++;
2510 #endif
2511
2512 LeaveCS();
2513 /* -------------------- critical section -------------------- */
2514
2515 res = WaitForMultipleObjects (hl_len, hl, FALSE, INFINITE);
2516
2517 /* if the ProcListEvt has been signaled then the list of processes has been
2518 updated to add or remove a handle, just loop over */
2519
2520 if (res - WAIT_OBJECT_0 == 0)
2521 {
2522 free (hl);
2523 free (pidl);
2524 goto START_WAIT;
2525 }
2526
2527 h = hl[res - WAIT_OBJECT_0];
2528 GetExitCodeProcess (h, &exitcode);
2529 pid = pidl [res - WAIT_OBJECT_0];
2530
2531 found = __gnat_win32_remove_handle (h, -1);
2532
2533 free (hl);
2534 free (pidl);
2535
2536 /* if not found another process waiting has already handled this process */
2537
2538 if (!found)
2539 {
2540 goto START_WAIT;
2541 }
2542
2543 *status = (int) exitcode;
2544 return (int) pid;
2545 }
2546
2547 #endif
2548
2549 int
__gnat_portable_no_block_spawn(char * args[]ATTRIBUTE_UNUSED)2550 __gnat_portable_no_block_spawn (char *args[] ATTRIBUTE_UNUSED)
2551 {
2552
2553 #if defined (__vxworks) || defined (__PikeOS__)
2554 /* Not supported. */
2555 return -1;
2556
2557 #elif defined (_WIN32)
2558
2559 HANDLE h = NULL;
2560 int pid;
2561
2562 win32_no_block_spawn (args[0], args, &h, &pid);
2563 if (h != NULL)
2564 {
2565 add_handle (h, pid);
2566 return pid;
2567 }
2568 else
2569 return -1;
2570
2571 #else
2572
2573 int pid = fork ();
2574
2575 if (pid == 0)
2576 {
2577 /* The child. */
2578 if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
2579 _exit (1);
2580 }
2581
2582 return pid;
2583
2584 #endif
2585 }
2586
2587 int
__gnat_portable_wait(int * process_status)2588 __gnat_portable_wait (int *process_status)
2589 {
2590 int status = 0;
2591 int pid = 0;
2592
2593 #if defined (__vxworks) || defined (__PikeOS__)
2594 /* Not sure what to do here, so do nothing but return zero. */
2595
2596 #elif defined (_WIN32)
2597
2598 pid = win32_wait (&status);
2599
2600 #else
2601
2602 pid = waitpid (-1, &status, 0);
2603 status = status & 0xffff;
2604 #endif
2605
2606 *process_status = status;
2607 return pid;
2608 }
2609
2610 void
__gnat_os_exit(int status)2611 __gnat_os_exit (int status)
2612 {
2613 exit (status);
2614 }
2615
2616 /* Locate file on path, that matches a predicate */
2617
2618 char *
__gnat_locate_file_with_predicate(char * file_name,char * path_val,int (* predicate)(char *))2619 __gnat_locate_file_with_predicate (char *file_name, char *path_val,
2620 int (*predicate)(char *))
2621 {
2622 char *ptr;
2623 char *file_path = (char *) alloca (strlen (file_name) + 1);
2624 int absolute;
2625
2626 /* Return immediately if file_name is empty */
2627
2628 if (*file_name == '\0')
2629 return 0;
2630
2631 /* Remove quotes around file_name if present */
2632
2633 ptr = file_name;
2634 if (*ptr == '"')
2635 ptr++;
2636
2637 strcpy (file_path, ptr);
2638
2639 ptr = file_path + strlen (file_path) - 1;
2640
2641 if (*ptr == '"')
2642 *ptr = '\0';
2643
2644 /* Handle absolute pathnames. */
2645
2646 absolute = __gnat_is_absolute_path (file_path, strlen (file_name));
2647
2648 if (absolute)
2649 {
2650 if (predicate (file_path))
2651 return xstrdup (file_path);
2652
2653 return 0;
2654 }
2655
2656 /* If file_name include directory separator(s), try it first as
2657 a path name relative to the current directory */
2658 for (ptr = file_name; *ptr && *ptr != '/' && *ptr != DIR_SEPARATOR; ptr++)
2659 ;
2660
2661 if (*ptr != 0)
2662 {
2663 if (predicate (file_name))
2664 return xstrdup (file_name);
2665 }
2666
2667 if (path_val == 0)
2668 return 0;
2669
2670 {
2671 /* The result has to be smaller than path_val + file_name. */
2672 char *file_path =
2673 (char *) alloca (strlen (path_val) + strlen (file_name) + 2);
2674
2675 for (;;)
2676 {
2677 /* Skip the starting quote */
2678
2679 if (*path_val == '"')
2680 path_val++;
2681
2682 for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
2683 *ptr++ = *path_val++;
2684
2685 /* If directory is empty, it is the current directory*/
2686
2687 if (ptr == file_path)
2688 {
2689 *ptr = '.';
2690 }
2691 else
2692 ptr--;
2693
2694 /* Skip the ending quote */
2695
2696 if (*ptr == '"')
2697 ptr--;
2698
2699 if (*ptr != '/' && *ptr != DIR_SEPARATOR)
2700 *++ptr = DIR_SEPARATOR;
2701
2702 strcpy (++ptr, file_name);
2703
2704 if (predicate (file_path))
2705 return xstrdup (file_path);
2706
2707 if (*path_val == 0)
2708 return 0;
2709
2710 /* Skip path separator */
2711
2712 path_val++;
2713 }
2714 }
2715
2716 return 0;
2717 }
2718
2719 /* Locate an executable file, give a Path value. */
2720
2721 char *
__gnat_locate_executable_file(char * file_name,char * path_val)2722 __gnat_locate_executable_file (char *file_name, char *path_val)
2723 {
2724 return __gnat_locate_file_with_predicate
2725 (file_name, path_val, &__gnat_is_executable_file);
2726 }
2727
2728 /* Locate a regular file, give a Path value. */
2729
2730 char *
__gnat_locate_regular_file(char * file_name,char * path_val)2731 __gnat_locate_regular_file (char *file_name, char *path_val)
2732 {
2733 return __gnat_locate_file_with_predicate
2734 (file_name, path_val, &__gnat_is_regular_file);
2735 }
2736
2737 /* Locate an executable given a Path argument. This routine is only used by
2738 gnatbl and should not be used otherwise. Use locate_exec_on_path
2739 instead. */
2740
2741 char *
__gnat_locate_exec(char * exec_name,char * path_val)2742 __gnat_locate_exec (char *exec_name, char *path_val)
2743 {
2744 char *ptr;
2745 if (!strstr (exec_name, HOST_EXECUTABLE_SUFFIX))
2746 {
2747 char *full_exec_name =
2748 (char *) alloca
2749 (strlen (exec_name) + strlen (HOST_EXECUTABLE_SUFFIX) + 1);
2750
2751 strcpy (full_exec_name, exec_name);
2752 strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
2753 ptr = __gnat_locate_executable_file (full_exec_name, path_val);
2754
2755 if (ptr == 0)
2756 return __gnat_locate_executable_file (exec_name, path_val);
2757 return ptr;
2758 }
2759 else
2760 return __gnat_locate_executable_file (exec_name, path_val);
2761 }
2762
2763 /* Locate an executable using the Systems default PATH. */
2764
2765 char *
__gnat_locate_exec_on_path(char * exec_name)2766 __gnat_locate_exec_on_path (char *exec_name)
2767 {
2768 char *apath_val;
2769
2770 #if defined (_WIN32)
2771 TCHAR *wpath_val = _tgetenv (_T("PATH"));
2772 TCHAR *wapath_val;
2773 /* In Win32 systems we expand the PATH as for XP environment
2774 variables are not automatically expanded. We also prepend the
2775 ".;" to the path to match normal NT path search semantics */
2776
2777 #define EXPAND_BUFFER_SIZE 32767
2778
2779 wapath_val = (TCHAR *) alloca (EXPAND_BUFFER_SIZE);
2780
2781 wapath_val [0] = '.';
2782 wapath_val [1] = ';';
2783
2784 DWORD res = ExpandEnvironmentStrings
2785 (wpath_val, &wapath_val[2], EXPAND_BUFFER_SIZE - 2);
2786
2787 if (!res) wapath_val [0] = _T('\0');
2788
2789 apath_val = (char *) alloca (EXPAND_BUFFER_SIZE);
2790
2791 WS2SC (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
2792
2793 #else
2794 const char *path_val = getenv ("PATH");
2795
2796 /* If PATH is not defined, proceed with __gnat_locate_exec anyway, so we can
2797 find files that contain directory names. */
2798
2799 if (path_val == NULL) path_val = "";
2800 apath_val = (char *) alloca (strlen (path_val) + 1);
2801 strcpy (apath_val, path_val);
2802 #endif
2803
2804 return __gnat_locate_exec (exec_name, apath_val);
2805 }
2806
2807 /* Dummy functions for Osint import for non-VMS systems.
2808 ??? To be removed. */
2809
2810 int
__gnat_to_canonical_file_list_init(char * dirspec ATTRIBUTE_UNUSED,int onlydirs ATTRIBUTE_UNUSED)2811 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED,
2812 int onlydirs ATTRIBUTE_UNUSED)
2813 {
2814 return 0;
2815 }
2816
2817 char *
__gnat_to_canonical_file_list_next(void)2818 __gnat_to_canonical_file_list_next (void)
2819 {
2820 static char empty[] = "";
2821 return empty;
2822 }
2823
2824 void
__gnat_to_canonical_file_list_free(void)2825 __gnat_to_canonical_file_list_free (void)
2826 {
2827 }
2828
2829 char *
__gnat_to_canonical_dir_spec(char * dirspec,int prefixflag ATTRIBUTE_UNUSED)2830 __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2831 {
2832 return dirspec;
2833 }
2834
2835 char *
__gnat_to_canonical_file_spec(char * filespec)2836 __gnat_to_canonical_file_spec (char *filespec)
2837 {
2838 return filespec;
2839 }
2840
2841 char *
__gnat_to_canonical_path_spec(char * pathspec)2842 __gnat_to_canonical_path_spec (char *pathspec)
2843 {
2844 return pathspec;
2845 }
2846
2847 char *
__gnat_to_host_dir_spec(char * dirspec,int prefixflag ATTRIBUTE_UNUSED)2848 __gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2849 {
2850 return dirspec;
2851 }
2852
2853 char *
__gnat_to_host_file_spec(char * filespec)2854 __gnat_to_host_file_spec (char *filespec)
2855 {
2856 return filespec;
2857 }
2858
2859 void
__gnat_adjust_os_resource_limits(void)2860 __gnat_adjust_os_resource_limits (void)
2861 {
2862 }
2863
2864 #if defined (__mips_vxworks)
2865 int
_flush_cache(void)2866 _flush_cache (void)
2867 {
2868 CACHE_USER_FLUSH (0, ENTIRE_CACHE);
2869 }
2870 #endif
2871
2872 #if defined (_WIN32)
2873 int __gnat_argument_needs_quote = 1;
2874 #else
2875 int __gnat_argument_needs_quote = 0;
2876 #endif
2877
2878 /* This option is used to enable/disable object files handling from the
2879 binder file by the GNAT Project module. For example, this is disabled on
2880 Windows (prior to GCC 3.4) as it is already done by the mdll module.
2881 Stating with GCC 3.4 the shared libraries are not based on mdll
2882 anymore as it uses the GCC's -shared option */
2883 #if defined (_WIN32) \
2884 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
2885 int __gnat_prj_add_obj_files = 0;
2886 #else
2887 int __gnat_prj_add_obj_files = 1;
2888 #endif
2889
2890 /* char used as prefix/suffix for environment variables */
2891 #if defined (_WIN32)
2892 char __gnat_environment_char = '%';
2893 #else
2894 char __gnat_environment_char = '$';
2895 #endif
2896
2897 /* This functions copy the file attributes from a source file to a
2898 destination file.
2899
2900 mode = 0 : In this mode copy only the file time stamps (last access and
2901 last modification time stamps).
2902
2903 mode = 1 : In this mode, time stamps and read/write/execute attributes are
2904 copied.
2905
2906 mode = 2 : In this mode, only read/write/execute attributes are copied
2907
2908 Returns 0 if operation was successful and -1 in case of error. */
2909
2910 int
__gnat_copy_attribs(char * from ATTRIBUTE_UNUSED,char * to ATTRIBUTE_UNUSED,int mode ATTRIBUTE_UNUSED)2911 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED,
2912 int mode ATTRIBUTE_UNUSED)
2913 {
2914 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2915 return -1;
2916
2917 #elif defined (_WIN32)
2918 TCHAR wfrom [GNAT_MAX_PATH_LEN + 2];
2919 TCHAR wto [GNAT_MAX_PATH_LEN + 2];
2920 BOOL res;
2921 FILETIME fct, flat, flwt;
2922 HANDLE hfrom, hto;
2923
2924 S2WSC (wfrom, from, GNAT_MAX_PATH_LEN + 2);
2925 S2WSC (wto, to, GNAT_MAX_PATH_LEN + 2);
2926
2927 /* Do we need to copy the timestamp ? */
2928
2929 if (mode != 2) {
2930 /* retrieve from times */
2931
2932 hfrom = CreateFile
2933 (wfrom, GENERIC_READ, 0, NULL, OPEN_EXISTING,
2934 FILE_ATTRIBUTE_NORMAL, NULL);
2935
2936 if (hfrom == INVALID_HANDLE_VALUE)
2937 return -1;
2938
2939 res = GetFileTime (hfrom, &fct, &flat, &flwt);
2940
2941 CloseHandle (hfrom);
2942
2943 if (res == 0)
2944 return -1;
2945
2946 /* retrieve from times */
2947
2948 hto = CreateFile
2949 (wto, GENERIC_WRITE, 0, NULL, OPEN_EXISTING,
2950 FILE_ATTRIBUTE_NORMAL, NULL);
2951
2952 if (hto == INVALID_HANDLE_VALUE)
2953 return -1;
2954
2955 res = SetFileTime (hto, NULL, &flat, &flwt);
2956
2957 CloseHandle (hto);
2958
2959 if (res == 0)
2960 return -1;
2961 }
2962
2963 /* Do we need to copy the permissions ? */
2964 /* Set file attributes in full mode. */
2965
2966 if (mode != 0)
2967 {
2968 DWORD attribs = GetFileAttributes (wfrom);
2969
2970 if (attribs == INVALID_FILE_ATTRIBUTES)
2971 return -1;
2972
2973 res = SetFileAttributes (wto, attribs);
2974 if (res == 0)
2975 return -1;
2976 }
2977
2978 return 0;
2979
2980 #else
2981 GNAT_STRUCT_STAT fbuf;
2982 struct utimbuf tbuf;
2983
2984 if (GNAT_STAT (from, &fbuf) == -1) {
2985 return -1;
2986 }
2987
2988 /* Do we need to copy timestamp ? */
2989 if (mode != 2) {
2990 tbuf.actime = fbuf.st_atime;
2991 tbuf.modtime = fbuf.st_mtime;
2992
2993 if (utime (to, &tbuf) == -1) {
2994 return -1;
2995 }
2996 }
2997
2998 /* Do we need to copy file permissions ? */
2999 if (mode != 0 && (chmod (to, fbuf.st_mode) == -1)) {
3000 return -1;
3001 }
3002
3003 return 0;
3004 #endif
3005 }
3006
3007 int
__gnat_lseek(int fd,long offset,int whence)3008 __gnat_lseek (int fd, long offset, int whence)
3009 {
3010 return (int) lseek (fd, offset, whence);
3011 }
3012
3013 /* This function returns the major version number of GCC being used. */
3014 int
get_gcc_version(void)3015 get_gcc_version (void)
3016 {
3017 #ifdef IN_RTS
3018 return __GNUC__;
3019 #else
3020 return (int) (version_string[0] - '0');
3021 #endif
3022 }
3023
3024 /*
3025 * Set Close_On_Exec as indicated.
3026 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
3027 */
3028
3029 int
__gnat_set_close_on_exec(int fd ATTRIBUTE_UNUSED,int close_on_exec_p ATTRIBUTE_UNUSED)3030 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED,
3031 int close_on_exec_p ATTRIBUTE_UNUSED)
3032 {
3033 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3034 int flags = fcntl (fd, F_GETFD, 0);
3035 if (flags < 0)
3036 return flags;
3037 if (close_on_exec_p)
3038 flags |= FD_CLOEXEC;
3039 else
3040 flags &= ~FD_CLOEXEC;
3041 return fcntl (fd, F_SETFD, flags);
3042 #elif defined(_WIN32)
3043 HANDLE h = (HANDLE) _get_osfhandle (fd);
3044 if (h == (HANDLE) -1)
3045 return -1;
3046 if (close_on_exec_p)
3047 return ! SetHandleInformation (h, HANDLE_FLAG_INHERIT, 0);
3048 return ! SetHandleInformation (h, HANDLE_FLAG_INHERIT,
3049 HANDLE_FLAG_INHERIT);
3050 #else
3051 /* TODO: Unimplemented. */
3052 return -1;
3053 #endif
3054 }
3055
3056 /* Indicates if platforms supports automatic initialization through the
3057 constructor mechanism */
3058 int
__gnat_binder_supports_auto_init(void)3059 __gnat_binder_supports_auto_init (void)
3060 {
3061 return 1;
3062 }
3063
3064 /* Indicates that Stand-Alone Libraries are automatically initialized through
3065 the constructor mechanism */
3066 int
__gnat_sals_init_using_constructors(void)3067 __gnat_sals_init_using_constructors (void)
3068 {
3069 #if defined (__vxworks) || defined (__Lynx__)
3070 return 0;
3071 #else
3072 return 1;
3073 #endif
3074 }
3075
3076 #if defined (__linux__) || defined (__ANDROID__)
3077 /* There is no function in the glibc to retrieve the LWP of the current
3078 thread. We need to do a system call in order to retrieve this
3079 information. */
3080 #include <sys/syscall.h>
3081 void *
__gnat_lwp_self(void)3082 __gnat_lwp_self (void)
3083 {
3084 return (void *) syscall (__NR_gettid);
3085 }
3086 #endif
3087
3088 #if defined (__linux__)
3089 #include <sched.h>
3090
3091 /* glibc versions earlier than 2.7 do not define the routines to handle
3092 dynamically allocated CPU sets. For these targets, we use the static
3093 versions. */
3094
3095 #ifdef CPU_ALLOC
3096
3097 /* Dynamic cpu sets */
3098
3099 cpu_set_t *
__gnat_cpu_alloc(size_t count)3100 __gnat_cpu_alloc (size_t count)
3101 {
3102 return CPU_ALLOC (count);
3103 }
3104
3105 size_t
__gnat_cpu_alloc_size(size_t count)3106 __gnat_cpu_alloc_size (size_t count)
3107 {
3108 return CPU_ALLOC_SIZE (count);
3109 }
3110
3111 void
__gnat_cpu_free(cpu_set_t * set)3112 __gnat_cpu_free (cpu_set_t *set)
3113 {
3114 CPU_FREE (set);
3115 }
3116
3117 void
__gnat_cpu_zero(size_t count,cpu_set_t * set)3118 __gnat_cpu_zero (size_t count, cpu_set_t *set)
3119 {
3120 CPU_ZERO_S (count, set);
3121 }
3122
3123 void
__gnat_cpu_set(int cpu,size_t count,cpu_set_t * set)3124 __gnat_cpu_set (int cpu, size_t count, cpu_set_t *set)
3125 {
3126 /* Ada handles CPU numbers starting from 1, while C identifies the first
3127 CPU by a 0, so we need to adjust. */
3128 CPU_SET_S (cpu - 1, count, set);
3129 }
3130
3131 #else /* !CPU_ALLOC */
3132
3133 /* Static cpu sets */
3134
3135 cpu_set_t *
__gnat_cpu_alloc(size_t count ATTRIBUTE_UNUSED)3136 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED)
3137 {
3138 return (cpu_set_t *) xmalloc (sizeof (cpu_set_t));
3139 }
3140
3141 size_t
__gnat_cpu_alloc_size(size_t count ATTRIBUTE_UNUSED)3142 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED)
3143 {
3144 return sizeof (cpu_set_t);
3145 }
3146
3147 void
__gnat_cpu_free(cpu_set_t * set)3148 __gnat_cpu_free (cpu_set_t *set)
3149 {
3150 free (set);
3151 }
3152
3153 void
__gnat_cpu_zero(size_t count ATTRIBUTE_UNUSED,cpu_set_t * set)3154 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
3155 {
3156 CPU_ZERO (set);
3157 }
3158
3159 void
__gnat_cpu_set(int cpu,size_t count ATTRIBUTE_UNUSED,cpu_set_t * set)3160 __gnat_cpu_set (int cpu, size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
3161 {
3162 /* Ada handles CPU numbers starting from 1, while C identifies the first
3163 CPU by a 0, so we need to adjust. */
3164 CPU_SET (cpu - 1, set);
3165 }
3166 #endif /* !CPU_ALLOC */
3167 #endif /* __linux__ */
3168
3169 /* Return the load address of the executable, or 0 if not known. In the
3170 specific case of error, (void *)-1 can be returned. Beware: this unit may
3171 be in a shared library. As low-level units are needed, we allow #include
3172 here. */
3173
3174 #if defined (__APPLE__)
3175 #include <mach-o/dyld.h>
3176 #endif
3177
3178 const void *
__gnat_get_executable_load_address(void)3179 __gnat_get_executable_load_address (void)
3180 {
3181 #if defined (__APPLE__)
3182 return _dyld_get_image_header (0);
3183
3184 #elif 0 && defined (__linux__)
3185 /* Currently disabled as it needs at least -ldl. */
3186 struct link_map *map = _r_debug.r_map;
3187
3188 return (const void *)map->l_addr;
3189
3190 #else
3191 return NULL;
3192 #endif
3193 }
3194
3195 void
__gnat_kill(int pid,int sig,int close ATTRIBUTE_UNUSED)3196 __gnat_kill (int pid, int sig, int close ATTRIBUTE_UNUSED)
3197 {
3198 #if defined(_WIN32)
3199 HANDLE h = OpenProcess (PROCESS_ALL_ACCESS, FALSE, pid);
3200 if (h == NULL)
3201 return;
3202 if (sig == 9)
3203 {
3204 TerminateProcess (h, 1);
3205 }
3206 else if (sig == SIGINT)
3207 GenerateConsoleCtrlEvent (CTRL_C_EVENT, pid);
3208 else if (sig == SIGBREAK)
3209 GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid);
3210 /* ??? The last two alternatives don't really work. SIGBREAK requires setting
3211 up process groups at start time which we don't do; treating SIGINT is just
3212 not possible apparently. So we really only support signal 9. Fortunately
3213 that's all we use in GNAT.Expect */
3214
3215 CloseHandle (h);
3216 #elif defined (__vxworks)
3217 /* Not implemented */
3218 #else
3219 kill (pid, sig);
3220 #endif
3221 }
3222
__gnat_killprocesstree(int pid,int sig_num)3223 void __gnat_killprocesstree (int pid, int sig_num)
3224 {
3225 #if defined(_WIN32)
3226 HANDLE hWnd;
3227 PROCESSENTRY32 pe;
3228
3229 memset(&pe, 0, sizeof(PROCESSENTRY32));
3230 pe.dwSize = sizeof(PROCESSENTRY32);
3231
3232 HANDLE hSnap = CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS, 0);
3233
3234 /* cannot take snapshot, just kill the parent process */
3235
3236 if (hSnap == INVALID_HANDLE_VALUE)
3237 {
3238 __gnat_kill (pid, sig_num, 1);
3239 return;
3240 }
3241
3242 if (Process32First(hSnap, &pe))
3243 {
3244 BOOL bContinue = TRUE;
3245
3246 /* kill child processes first */
3247
3248 while (bContinue)
3249 {
3250 if (pe.th32ParentProcessID == (int)pid)
3251 __gnat_killprocesstree (pe.th32ProcessID, sig_num);
3252
3253 bContinue = Process32Next (hSnap, &pe);
3254 }
3255 }
3256
3257 CloseHandle (hSnap);
3258
3259 /* kill process */
3260
3261 __gnat_kill (pid, sig_num, 1);
3262
3263 #elif defined (__vxworks)
3264 /* not implemented */
3265
3266 #elif defined (__linux__)
3267 DIR *dir;
3268 struct dirent *d;
3269
3270 /* read all processes' pid and ppid */
3271
3272 dir = opendir ("/proc");
3273
3274 /* cannot open proc, just kill the parent process */
3275
3276 if (!dir)
3277 {
3278 __gnat_kill (pid, sig_num, 1);
3279 return;
3280 }
3281
3282 /* kill child processes first */
3283
3284 while ((d = readdir (dir)) != NULL)
3285 {
3286 if ((d->d_type & DT_DIR) == DT_DIR)
3287 {
3288 char statfile[64] = { 0 };
3289 int _pid, _ppid;
3290
3291 /* read /proc/<PID>/stat */
3292
3293 strncpy (statfile, "/proc/", sizeof(statfile));
3294 strncat (statfile, d->d_name, sizeof(statfile));
3295 strncat (statfile, "/stat", sizeof(statfile));
3296
3297 FILE *fd = fopen (statfile, "r");
3298
3299 if (fd)
3300 {
3301 const int match = fscanf (fd, "%d %*s %*s %d", &_pid, &_ppid);
3302 fclose (fd);
3303
3304 if (match == 2 && _ppid == pid)
3305 __gnat_killprocesstree (_pid, sig_num);
3306 }
3307 }
3308 }
3309
3310 closedir (dir);
3311
3312 /* kill process */
3313
3314 __gnat_kill (pid, sig_num, 1);
3315 #else
3316 __gnat_kill (pid, sig_num, 1);
3317 #endif
3318 /* Note on Solaris it is possible to read /proc/<PID>/status.
3319 The 5th and 6th words are the pid and the 7th and 8th the ppid.
3320 See: /usr/include/sys/procfs.h (struct pstatus).
3321 */
3322 }
3323
3324 #ifdef __cplusplus
3325 }
3326 #endif
3327