1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2015, Free Software Foundation, Inc. *
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. *
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. *
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/>. *
27 * GNAT was originally developed by the GNAT team at New York University. *
28 * Extensive contributions were provided by Ada Core Technologies Inc. *
30 ****************************************************************************/
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. */
37 /* Ensure access to errno is thread safe. */
41 /* Use 64 bit Large File API */
42 #ifndef _LARGEFILE_SOURCE
43 #define _LARGEFILE_SOURCE
45 #define _FILE_OFFSET_BITS 64
49 /* No need to redefine exit here. */
52 /* We want to use the POSIX variants of include files. */
56 #if defined (__mips_vxworks)
58 #endif /* __mips_vxworks */
60 /* If SMP, access vxCpuConfiguredGet */
61 #ifdef _WRS_CONFIG_SMP
63 #endif /* _WRS_CONFIG_SMP */
65 /* We need to know the VxWorks version because some file operations
66 (such as chmod) are only available on VxWorks 6. */
71 #if defined (__APPLE__)
75 #if defined (__hpux__)
76 #include <sys/param.h>
77 #include <sys/pstat.h>
81 #define __BSD_VISIBLE 1
91 #if defined (__vxworks) || defined (__ANDROID__)
92 /* S_IREAD and S_IWRITE are not defined in VxWorks or Android */
94 #define S_IREAD (S_IRUSR | S_IRGRP | S_IROTH)
98 #define S_IWRITE (S_IWUSR)
102 /* We don't have libiberty, so use malloc. */
103 #define xmalloc(S) malloc (S)
104 #define xrealloc(V,S) realloc (V,S)
115 #if defined (__MINGW32__) || defined (__CYGWIN__)
119 /* Current code page and CCS encoding to use, set in initialize.c. */
120 UINT CurrentCodePage
;
121 UINT CurrentCCSEncoding
;
123 #include <sys/utime.h>
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. */
131 #define ISALPHA isalpha
134 #elif defined (__Lynx__)
136 /* Lynx utime.h only defines the entities of interest to us if
137 defined (VMOS_DEV), so ... */
146 /* wait.h processing */
149 # include <sys/wait.h>
151 #elif defined (__vxworks) && defined (__RTP__)
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. */
165 #include <sys/wait.h>
176 #include <tlhelp32.h>
178 #define DIR_SEPARATOR '\\'
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. */
200 #ifndef HOST_EXECUTABLE_SUFFIX
201 #define HOST_EXECUTABLE_SUFFIX ""
204 #ifndef HOST_OBJECT_SUFFIX
205 #define HOST_OBJECT_SUFFIX ".o"
208 #ifndef PATH_SEPARATOR
209 #define PATH_SEPARATOR ':'
212 #ifndef DIR_SEPARATOR
213 #define DIR_SEPARATOR '/'
216 /* Check for cross-compilation. */
217 #if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
219 int __gnat_is_cross_compiler
= 1;
222 int __gnat_is_cross_compiler
= 0;
225 char __gnat_dir_separator
= DIR_SEPARATOR
;
227 char __gnat_path_separator
= PATH_SEPARATOR
;
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
234 library_template ::= { pattern ; } pattern NUL
235 pattern ::= [ prefix ] * [ postfix ]
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
242 * if they are needed but not present, the link
245 * otherwise they are libraries in the system paths and so
246 they are considered part of the system and not checked
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. */
253 #ifndef GNAT_LIBRARY_TEMPLATE
254 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
257 const char *__gnat_library_template
= GNAT_LIBRARY_TEMPLATE
;
259 #if defined (__vxworks)
260 #define GNAT_MAX_PATH_LEN PATH_MAX
264 #if defined (__MINGW32__)
268 #include <sys/param.h>
272 #include <sys/param.h>
276 #define GNAT_MAX_PATH_LEN MAXPATHLEN
278 #define GNAT_MAX_PATH_LEN 256
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
286 int __gnat_size_of_file_attributes
= sizeof (struct file_attributes
);
288 void __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
);
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
295 int __gnat_max_path_len
= GNAT_MAX_PATH_LEN
;
296 int max_path_len
= GNAT_MAX_PATH_LEN
;
298 /* Control whether we can use ACL on Windows. */
300 int __gnat_use_acl
= 1;
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
307 #define MAYBE_TO_PTR32(argv) argv
309 static const char ATTR_UNSET
= 127;
311 /* Reset the file attributes as if no system call had been performed */
314 __gnat_reset_attributes (struct file_attributes
* attr
)
316 attr
->exists
= ATTR_UNSET
;
317 attr
->error
= EINVAL
;
319 attr
->writable
= ATTR_UNSET
;
320 attr
->readable
= ATTR_UNSET
;
321 attr
->executable
= ATTR_UNSET
;
323 attr
->regular
= ATTR_UNSET
;
324 attr
->symbolic_link
= ATTR_UNSET
;
325 attr
->directory
= ATTR_UNSET
;
327 attr
->timestamp
= (OS_Time
)-2;
328 attr
->file_length
= -1;
332 __gnat_error_attributes (struct file_attributes
*attr
) {
337 __gnat_current_time (void)
339 time_t res
= time (NULL
);
340 return (OS_Time
) res
;
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
348 __gnat_current_time_string (char *result
)
350 const char *format
= "%Y-%m-%d %H:%M:%S";
351 /* Format string necessary to describe the ISO 8601 format */
353 const time_t t_val
= time (NULL
);
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. */
362 /* The sub-seconds are manually set to zero since type time_t lacks the
363 precision necessary for nanoseconds. */
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
)
371 time_t time
= (time_t) *p_time
;
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. */
380 res
= gmtime (&time
);
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
;
391 *p_year
= *p_month
= *p_day
= *p_hours
= *p_mins
= *p_secs
= 0;
395 __gnat_to_os_time (OS_Time
*p_time
, int year
, int month
, int day
,
396 int hours
, int mins
, int secs
)
408 /* returns -1 of failing, this is s-os_lib Invalid_Time */
410 *p_time
= (OS_Time
) mktime (&v
);
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. */
419 __gnat_readlink (char *path ATTRIBUTE_UNUSED
,
420 char *buf ATTRIBUTE_UNUSED
,
421 size_t bufsiz ATTRIBUTE_UNUSED
)
423 #if defined (_WIN32) \
424 || defined(__vxworks) || defined (__PikeOS__)
427 return readlink (path
, buf
, bufsiz
);
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. */
436 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED
,
437 char *newpath ATTRIBUTE_UNUSED
)
439 #if defined (_WIN32) \
440 || defined(__vxworks) || defined (__PikeOS__)
443 return symlink (oldpath
, newpath
);
447 /* Try to lock a file, return 1 if success. */
449 #if defined (__vxworks) \
450 || defined (_WIN32) || defined (__PikeOS__)
452 /* Version that does not use link. */
455 __gnat_try_lock (char *dir
, char *file
)
459 TCHAR wfull_path
[GNAT_MAX_PATH_LEN
];
460 TCHAR wfile
[GNAT_MAX_PATH_LEN
];
461 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
463 S2WSC (wdir
, dir
, GNAT_MAX_PATH_LEN
);
464 S2WSC (wfile
, file
, GNAT_MAX_PATH_LEN
);
466 /* ??? the code below crash on MingW64 for obscure reasons, a ticket
467 has been opened here:
469 https://sourceforge.net/p/mingw-w64/bugs/414/
471 As a workaround an equivalent set of code has been put in place below.
473 _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
476 _tcscpy (wfull_path
, wdir
);
477 _tcscat (wfull_path
, L
"\\");
478 _tcscat (wfull_path
, wfile
);
480 fd
= _topen (wfull_path
, O_CREAT
| O_EXCL
, 0600);
484 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
485 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
497 /* Version using link(), more secure over NFS. */
498 /* See TN 6913-016 for discussion ??? */
501 __gnat_try_lock (char *dir
, char *file
)
505 GNAT_STRUCT_STAT stat_result
;
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 ());
512 /* Create the temporary file and write the process number. */
513 fd
= open (temp_file
, O_CREAT
| O_WRONLY
, 0600);
519 /* Link it with the new file. */
520 link (temp_file
, full_path
);
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
);
526 return stat_result
.st_nlink
== 2;
530 /* Return the maximum file name length. */
533 __gnat_get_maximum_file_name_length (void)
538 /* Return nonzero if file names are case sensitive. */
540 static int file_names_case_sensitive_cache
= -1;
543 __gnat_get_file_names_case_sensitive (void)
545 if (file_names_case_sensitive_cache
== -1)
547 const char *sensitive
= getenv ("GNAT_FILE_NAME_CASE_SENSITIVE");
549 if (sensitive
!= NULL
550 && (sensitive
[0] == '0' || sensitive
[0] == '1')
551 && sensitive
[1] == '\0')
552 file_names_case_sensitive_cache
= sensitive
[0] - '0';
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;
561 file_names_case_sensitive_cache
= 1;
565 return file_names_case_sensitive_cache
;
568 /* Return nonzero if environment variables are case sensitive. */
571 __gnat_get_env_vars_case_sensitive (void)
581 __gnat_get_default_identifier_character_set (void)
586 /* Return the current working directory. */
589 __gnat_get_current_dir (char *dir
, int *length
)
591 #if defined (__MINGW32__)
592 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
594 _tgetcwd (wdir
, *length
);
596 WS2SC (dir
, wdir
, GNAT_MAX_PATH_LEN
);
599 getcwd (dir
, *length
);
602 *length
= strlen (dir
);
604 if (dir
[*length
- 1] != DIR_SEPARATOR
)
606 dir
[*length
] = DIR_SEPARATOR
;
612 /* Return the suffix for object files. */
615 __gnat_get_object_suffix_ptr (int *len
, const char **value
)
617 *value
= HOST_OBJECT_SUFFIX
;
622 *len
= strlen (*value
);
627 /* Return the suffix for executable files. */
630 __gnat_get_executable_suffix_ptr (int *len
, const char **value
)
632 *value
= HOST_EXECUTABLE_SUFFIX
;
636 *len
= strlen (*value
);
641 /* Return the suffix for debuggable files. Usually this is the same as the
642 executable extension. */
645 __gnat_get_debuggable_suffix_ptr (int *len
, const char **value
)
647 *value
= HOST_EXECUTABLE_SUFFIX
;
652 *len
= strlen (*value
);
657 /* Returns the OS filename and corresponding encoding. */
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
)
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
);
671 strcpy (os_name
, filename
);
672 *o_length
= strlen (filename
);
680 __gnat_unlink (char *path
)
682 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
684 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
686 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
687 return _tunlink (wpath
);
690 return unlink (path
);
697 __gnat_rename (char *from
, char *to
)
699 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
701 TCHAR wfrom
[GNAT_MAX_PATH_LEN
], wto
[GNAT_MAX_PATH_LEN
];
703 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
);
704 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
);
705 return _trename (wfrom
, wto
);
708 return rename (from
, to
);
712 /* Changing directory. */
715 __gnat_chdir (char *path
)
717 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
719 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
721 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
722 return _tchdir (wpath
);
729 /* Removing a directory. */
732 __gnat_rmdir (char *path
)
734 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
736 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
738 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
739 return _trmdir (wpath
);
741 #elif defined (VTHREADS)
742 /* rmdir not available */
749 #if defined (_WIN32) || defined (__linux__) || defined (__sun__) \
750 || defined (__FreeBSD__) || defined(__DragonFly__)
751 #define HAS_TARGET_WCHAR_T
754 #ifdef HAS_TARGET_WCHAR_T
759 __gnat_fputwc(int c
, FILE *stream
)
761 #ifdef HAS_TARGET_WCHAR_T
762 return fputwc ((wchar_t)c
, stream
);
764 return fputc (c
, stream
);
769 __gnat_fopen (char *path
, char *mode
, int encoding ATTRIBUTE_UNUSED
)
771 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
772 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
775 S2WS (wmode
, mode
, 10);
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
);
782 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
784 return _tfopen (wpath
, wmode
);
787 return GNAT_FOPEN (path
, mode
);
792 __gnat_freopen (char *path
,
795 int encoding ATTRIBUTE_UNUSED
)
797 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
798 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
801 S2WS (wmode
, mode
, 10);
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
);
808 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
810 return _tfreopen (wpath
, wmode
, stream
);
812 return freopen (path
, mode
, stream
);
817 __gnat_open_read (char *path
, int fmode
)
820 int o_fmode
= O_BINARY
;
825 #if defined (__vxworks)
826 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
827 #elif defined (__MINGW32__)
829 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
831 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
832 fd
= _topen (wpath
, O_RDONLY
| o_fmode
, 0444);
835 fd
= GNAT_OPEN (path
, O_RDONLY
| o_fmode
);
838 return fd
< 0 ? -1 : fd
;
841 #if defined (__MINGW32__)
842 #define PERM (S_IREAD | S_IWRITE)
844 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
848 __gnat_open_rw (char *path
, int fmode
)
851 int o_fmode
= O_BINARY
;
856 #if defined (__MINGW32__)
858 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
860 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
861 fd
= _topen (wpath
, O_RDWR
| o_fmode
, PERM
);
864 fd
= GNAT_OPEN (path
, O_RDWR
| o_fmode
, PERM
);
867 return fd
< 0 ? -1 : fd
;
871 __gnat_open_create (char *path
, int fmode
)
874 int o_fmode
= O_BINARY
;
879 #if defined (__MINGW32__)
881 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
883 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
884 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
887 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
890 return fd
< 0 ? -1 : fd
;
894 __gnat_create_output_file (char *path
)
897 #if defined (__MINGW32__)
899 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
901 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
902 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
905 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
908 return fd
< 0 ? -1 : fd
;
912 __gnat_create_output_file_new (char *path
)
915 #if defined (__MINGW32__)
917 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
919 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
920 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
923 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
926 return fd
< 0 ? -1 : fd
;
930 __gnat_open_append (char *path
, int fmode
)
933 int o_fmode
= O_BINARY
;
938 #if defined (__MINGW32__)
940 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
942 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
943 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
946 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
949 return fd
< 0 ? -1 : fd
;
952 /* Open a new file. Return error (-1) if the file already exists. */
955 __gnat_open_new (char *path
, int fmode
)
958 int o_fmode
= O_BINARY
;
963 #if defined (__MINGW32__)
965 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
967 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
968 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
971 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
974 return fd
< 0 ? -1 : fd
;
977 /* Open a new temp file. Return error (-1) if the file already exists. */
980 __gnat_open_new_temp (char *path
, int fmode
)
983 int o_fmode
= O_BINARY
;
985 strcpy (path
, "GNAT-XXXXXX");
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__)
994 if (mktemp (path
) == NULL
)
1001 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1002 return fd
< 0 ? -1 : fd
;
1006 __gnat_open (char *path
, int fmode
)
1010 #if defined (__MINGW32__)
1012 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1014 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1015 fd
= _topen (wpath
, fmode
, PERM
);
1018 fd
= GNAT_OPEN (path
, fmode
, PERM
);
1021 return fd
< 0 ? -1 : fd
;
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 ****************************************************************/
1030 __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
)
1032 GNAT_STRUCT_STAT statbuf
;
1036 /* GNAT_FSTAT returns -1 and sets errno for failure */
1037 ret
= GNAT_FSTAT (fd
, &statbuf
);
1038 error
= ret
? errno
: 0;
1041 /* __gnat_stat returns errno value directly */
1042 error
= __gnat_stat (name
, &statbuf
);
1043 ret
= error
? -1 : 0;
1047 * A missing file is reported as an attr structure with error == 0 and
1051 if (error
== 0 || error
== ENOENT
)
1054 attr
->error
= error
;
1056 attr
->regular
= (!ret
&& S_ISREG (statbuf
.st_mode
));
1057 attr
->directory
= (!ret
&& S_ISDIR (statbuf
.st_mode
));
1060 attr
->file_length
= 0;
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
1065 attr
->file_length
= statbuf
.st_size
; /* all systems */
1067 attr
->exists
= !ret
;
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
));
1077 attr
->timestamp
= (OS_Time
)-1;
1079 attr
->timestamp
= (OS_Time
)statbuf
.st_mtime
;
1083 /****************************************************************
1084 ** Return the number of bytes in the specified file
1085 ****************************************************************/
1088 __gnat_file_length_attr (int fd
, char* name
, struct file_attributes
* attr
)
1090 if (attr
->file_length
== -1) {
1091 __gnat_stat_to_attr (fd
, name
, attr
);
1094 return attr
->file_length
;
1098 __gnat_file_length (int fd
)
1100 struct file_attributes attr
;
1101 __gnat_reset_attributes (&attr
);
1102 return __gnat_file_length_attr (fd
, NULL
, &attr
);
1106 __gnat_file_length_long (int fd
)
1108 struct file_attributes attr
;
1109 __gnat_reset_attributes (&attr
);
1110 return (long)__gnat_file_length_attr (fd
, NULL
, &attr
);
1114 __gnat_named_file_length (char *name
)
1116 struct file_attributes attr
;
1117 __gnat_reset_attributes (&attr
);
1118 return __gnat_file_length_attr (-1, name
, &attr
);
1121 /* Create a temporary filename and put it in string pointed to by
1125 __gnat_tmp_name (char *tmp_filename
)
1127 #if defined (__MINGW32__)
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-". */
1137 sprintf (prefix
, "gnat-%d-", (int)getpid());
1138 pname
= (char *) _tempnam ("c:\\temp", prefix
);
1140 /* if pname is NULL, the file was not created properly, the disk is full
1141 or there is no more free temporary files */
1144 *tmp_filename
= '\0';
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. */
1149 else if (pname
[0] == '\\')
1151 strcpy (tmp_filename
, ".\\");
1152 strcat (tmp_filename
, pname
+1);
1155 strcpy (tmp_filename
, pname
);
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");
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
)
1170 strcpy (tmp_filename
, "/cache/gnat-XXXXXX");
1172 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
1175 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
1177 close (mkstemp(tmp_filename
));
1178 #elif defined (__vxworks) && !defined (VTHREADS)
1182 static ushort_t seed
= 0; /* used to generate unique name */
1184 /* Generate a unique name. */
1185 strcpy (tmp_filename
, "tmp");
1188 savepos
= pos
= tmp_filename
+ strlen (tmp_filename
) + index
;
1196 /* Fill up the name buffer from the last position. */
1198 for (t
= seed
; 0 <= --index
; t
>>= 3)
1199 *--pos
= '0' + (t
& 07);
1201 /* Check to see if its unique, if not bump the seed and try again. */
1202 f
= fopen (tmp_filename
, "r");
1210 tmpnam (tmp_filename
);
1214 /* Open directory and returns a DIR pointer. */
1216 DIR* __gnat_opendir (char *name
)
1218 #if defined (__MINGW32__)
1219 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1221 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1222 return (DIR*)_topendir (wname
);
1225 return opendir (name
);
1229 /* Read the next entry in a directory. The returned string points somewhere
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
1240 __gnat_readdir (DIR *dirp
, char *buffer
, int *len
)
1242 #if defined (__MINGW32__)
1243 struct _tdirent
*dirent
= _treaddir ((_TDIR
*)dirp
);
1247 WS2SC (buffer
, dirent
->d_name
, GNAT_MAX_PATH_LEN
);
1248 *len
= strlen (buffer
);
1255 #elif defined (HAVE_READDIR_R)
1256 /* If possible, try to use the thread-safe version. */
1257 if (readdir_r (dirp
, buffer
) != NULL
)
1259 *len
= strlen (((struct dirent
*) buffer
)->d_name
);
1260 return ((struct dirent
*) buffer
)->d_name
;
1266 struct dirent
*dirent
= (struct dirent
*) readdir (dirp
);
1270 strcpy (buffer
, dirent
->d_name
);
1271 *len
= strlen (buffer
);
1280 /* Close a directory entry. */
1282 int __gnat_closedir (DIR *dirp
)
1284 #if defined (__MINGW32__)
1285 return _tclosedir ((_TDIR
*)dirp
);
1288 return closedir (dirp
);
1292 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1295 __gnat_readdir_is_thread_safe (void)
1297 #ifdef HAVE_READDIR_R
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;
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
1314 win32_filetime (HANDLE h
)
1319 unsigned long long ull_time
;
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>. */
1326 if (GetFileTime (h
, NULL
, NULL
, &t_write
.ft_time
))
1327 return (time_t) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1331 /* As above but starting from a FILETIME. */
1333 f2t (const FILETIME
*ft
, __time64_t
*t
)
1338 unsigned long long ull_time
;
1341 t_write
.ft_time
= *ft
;
1342 *t
= (__time64_t
) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1346 /* Return a GNAT time stamp given a file name. */
1349 __gnat_file_time_name_attr (char* name
, struct file_attributes
* attr
)
1351 if (attr
->timestamp
== (OS_Time
)-2) {
1352 #if defined (_WIN32)
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
);
1359 if ((res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
)))
1360 f2t (&fad
.ftLastWriteTime
, &ret
);
1361 attr
->timestamp
= (OS_Time
) ret
;
1363 __gnat_stat_to_attr (-1, name
, attr
);
1366 return attr
->timestamp
;
1370 __gnat_file_time_name (char *name
)
1372 struct file_attributes attr
;
1373 __gnat_reset_attributes (&attr
);
1374 return __gnat_file_time_name_attr (name
, &attr
);
1377 /* Return a GNAT time stamp given a file descriptor. */
1380 __gnat_file_time_fd_attr (int fd
, struct file_attributes
* attr
)
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
;
1389 __gnat_stat_to_attr (fd
, NULL
, attr
);
1393 return attr
->timestamp
;
1397 __gnat_file_time_fd (int fd
)
1399 struct file_attributes attr
;
1400 __gnat_reset_attributes (&attr
);
1401 return __gnat_file_time_fd_attr (fd
, &attr
);
1404 /* Set the file time stamp. */
1407 __gnat_set_file_time_name (char *name
, time_t time_stamp
)
1409 #if defined (__vxworks)
1411 /* Code to implement __gnat_set_file_time_name for these systems. */
1413 #elif defined (_WIN32)
1417 unsigned long long ull_time
;
1419 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1421 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1423 HANDLE h
= CreateFile
1424 (wname
, GENERIC_WRITE
, FILE_SHARE_WRITE
, NULL
,
1425 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
,
1427 if (h
== INVALID_HANDLE_VALUE
)
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;
1434 SetFileTime(h
, NULL
, NULL
, &t_write
.ft_time
);
1439 struct utimbuf utimbuf
;
1442 /* Set modification time to requested time. */
1443 utimbuf
.modtime
= time_stamp
;
1445 /* Set access time to now in local time. */
1446 t
= time ((time_t) 0);
1447 utimbuf
.actime
= mktime (localtime (&t
));
1449 utime (name
, &utimbuf
);
1453 /* Get the list of installed standard libraries from the
1454 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1458 __gnat_get_libraries_from_registry (void)
1460 char *result
= (char *) xmalloc (1);
1464 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
1467 DWORD name_size
, value_size
;
1474 /* First open the key. */
1475 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1477 if (res
== ERROR_SUCCESS
)
1478 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1479 KEY_READ
, ®_key
);
1481 if (res
== ERROR_SUCCESS
)
1482 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1484 if (res
== ERROR_SUCCESS
)
1485 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1487 /* If the key exists, read out all the values in it and concatenate them
1489 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1491 value_size
= name_size
= 256;
1492 res
= RegEnumValueA (reg_key
, index
, name
, &name_size
, 0,
1493 &type
, (LPBYTE
)value
, &value_size
);
1495 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1497 char *old_result
= result
;
1499 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1500 strcpy (result
, old_result
);
1501 strcat (result
, value
);
1502 strcat (result
, ";");
1507 /* Remove the trailing ";". */
1509 result
[strlen (result
) - 1] = 0;
1515 /* Query information for the given file NAME and return it in STATBUF.
1516 * Returns 0 for success, or errno value for failure.
1519 __gnat_stat (char *name
, GNAT_STRUCT_STAT
*statbuf
)
1522 WIN32_FILE_ATTRIBUTE_DATA fad
;
1523 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1528 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1529 name_len
= _tcslen (wname
);
1531 if (name_len
> GNAT_MAX_PATH_LEN
)
1534 ZeroMemory (statbuf
, sizeof(GNAT_STRUCT_STAT
));
1536 res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
);
1539 error
= GetLastError();
1541 /* Check file existence using GetFileAttributes() which does not fail on
1542 special Windows files like con:, aux:, nul: etc... */
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
;
1551 case ERROR_ACCESS_DENIED
:
1552 case ERROR_SHARING_VIOLATION
:
1553 case ERROR_LOCK_VIOLATION
:
1554 case ERROR_SHARING_BUFFER_EXCEEDED
:
1556 case ERROR_BUFFER_OVERFLOW
:
1557 return ENAMETOOLONG
;
1558 case ERROR_NOT_ENOUGH_MEMORY
:
1565 f2t (&fad
.ftCreationTime
, &statbuf
->st_ctime
);
1566 f2t (&fad
.ftLastWriteTime
, &statbuf
->st_mtime
);
1567 f2t (&fad
.ftLastAccessTime
, &statbuf
->st_atime
);
1570 (__int64
)fad
.nFileSizeLow
| (__int64
)fad
.nFileSizeHigh
<< 32;
1572 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1573 statbuf
->st_mode
= S_IREAD
;
1575 if (fad
.dwFileAttributes
& FILE_ATTRIBUTE_DIRECTORY
)
1576 statbuf
->st_mode
|= S_IFDIR
;
1578 statbuf
->st_mode
|= S_IFREG
;
1580 if (!(fad
.dwFileAttributes
& FILE_ATTRIBUTE_READONLY
))
1581 statbuf
->st_mode
|= S_IWRITE
;
1586 return GNAT_STAT (name
, statbuf
) == 0 ? 0 : errno
;
1590 /*************************************************************************
1591 ** Check whether a file exists
1592 *************************************************************************/
1595 __gnat_file_exists_attr (char* name
, struct file_attributes
* attr
)
1597 if (attr
->exists
== ATTR_UNSET
)
1598 __gnat_stat_to_attr (-1, name
, attr
);
1600 return attr
->exists
;
1604 __gnat_file_exists (char *name
)
1606 struct file_attributes attr
;
1607 __gnat_reset_attributes (&attr
);
1608 return __gnat_file_exists_attr (name
, &attr
);
1611 /**********************************************************************
1612 ** Whether name is an absolute path
1613 **********************************************************************/
1616 __gnat_is_absolute_path (char *name
, int length
)
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. */
1628 for (index
= 0; index
< length
; index
++)
1630 if (name
[index
] == ':' &&
1631 ((name
[index
+ 1] == '/') ||
1632 (isalpha (name
[index
+ 1]) && index
+ 2 <= length
&&
1633 name
[index
+ 2] == '/')))
1636 else if (name
[index
] == '/')
1641 return (length
!= 0) &&
1642 (*name
== '/' || *name
== DIR_SEPARATOR
1644 || (length
> 1 && ISALPHA (name
[0]) && name
[1] == ':')
1651 __gnat_is_regular_file_attr (char* name
, struct file_attributes
* attr
)
1653 if (attr
->regular
== ATTR_UNSET
)
1654 __gnat_stat_to_attr (-1, name
, attr
);
1656 return attr
->regular
;
1660 __gnat_is_regular_file (char *name
)
1662 struct file_attributes attr
;
1664 __gnat_reset_attributes (&attr
);
1665 return __gnat_is_regular_file_attr (name
, &attr
);
1669 __gnat_is_regular_file_fd (int fd
)
1672 GNAT_STRUCT_STAT statbuf
;
1674 ret
= GNAT_FSTAT (fd
, &statbuf
);
1675 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1679 __gnat_is_directory_attr (char* name
, struct file_attributes
* attr
)
1681 if (attr
->directory
== ATTR_UNSET
)
1682 __gnat_stat_to_attr (-1, name
, attr
);
1684 return attr
->directory
;
1688 __gnat_is_directory (char *name
)
1690 struct file_attributes attr
;
1692 __gnat_reset_attributes (&attr
);
1693 return __gnat_is_directory_attr (name
, &attr
);
1696 #if defined (_WIN32)
1698 /* Returns the same constant as GetDriveType but takes a pathname as
1702 GetDriveTypeFromPath (TCHAR
*wfullpath
)
1704 TCHAR wdrv
[MAX_PATH
];
1705 TCHAR wpath
[MAX_PATH
];
1706 TCHAR wfilename
[MAX_PATH
];
1707 TCHAR wext
[MAX_PATH
];
1709 _tsplitpath (wfullpath
, wdrv
, wpath
, wfilename
, wext
);
1711 if (_tcslen (wdrv
) != 0)
1713 /* we have a drive specified. */
1714 _tcscat (wdrv
, _T("\\"));
1715 return GetDriveType (wdrv
);
1719 /* No drive specified. */
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
);
1727 UINT result
= GetDriveType (wpath
);
1729 /* Cannot guess the drive type, is this \\.\ ? */
1731 if (result
== DRIVE_NO_ROOT_DIR
&&
1732 _tcslen (wpath
) >= 4 && wpath
[0] == _T('\\') && wpath
[1] == _T('\\')
1733 && wpath
[2] == _T('.') && wpath
[3] == _T('\\'))
1735 if (_tcslen (wpath
) == 4)
1736 _tcscat (wpath
, wfilename
);
1738 LPTSTR p
= &wpath
[4];
1739 LPTSTR b
= _tcschr (p
, _T('\\'));
1743 /* logical drive \\.\c\dir\file */
1749 _tcscat (p
, _T(":\\"));
1751 return GetDriveType (p
);
1758 /* This MingW section contains code to work with ACL. */
1760 __gnat_check_OWNER_ACL (TCHAR
*wname
,
1761 DWORD CheckAccessDesired
,
1762 GENERIC_MAPPING CheckGenericMapping
)
1764 DWORD dwAccessDesired
, dwAccessAllowed
;
1765 PRIVILEGE_SET PrivilegeSet
;
1766 DWORD dwPrivSetSize
= sizeof (PRIVILEGE_SET
);
1767 BOOL fAccessGranted
= FALSE
;
1768 HANDLE hToken
= NULL
;
1770 PSECURITY_DESCRIPTOR pSD
= NULL
;
1773 (wname
, OWNER_SECURITY_INFORMATION
|
1774 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1777 if ((pSD
= (SECURITY_DESCRIPTOR
*) HeapAlloc
1778 (GetProcessHeap (), HEAP_ZERO_MEMORY
, nLength
)) == NULL
)
1781 /* Obtain the security descriptor. */
1783 if (!GetFileSecurity
1784 (wname
, OWNER_SECURITY_INFORMATION
|
1785 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1786 pSD
, nLength
, &nLength
))
1789 if (!ImpersonateSelf (SecurityImpersonation
))
1792 if (!OpenThreadToken
1793 (GetCurrentThread(), TOKEN_DUPLICATE
| TOKEN_QUERY
, FALSE
, &hToken
))
1796 /* Undoes the effect of ImpersonateSelf. */
1800 /* We want to test for write permissions. */
1802 dwAccessDesired
= CheckAccessDesired
;
1804 MapGenericMask (&dwAccessDesired
, &CheckGenericMapping
);
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 */
1817 CloseHandle (hToken
);
1818 HeapFree (GetProcessHeap (), 0, pSD
);
1819 return fAccessGranted
;
1823 CloseHandle (hToken
);
1824 HeapFree (GetProcessHeap (), 0, pSD
);
1829 __gnat_set_OWNER_ACL (TCHAR
*wname
,
1830 ACCESS_MODE AccessMode
,
1831 DWORD AccessPermissions
)
1833 PACL pOldDACL
= NULL
;
1834 PACL pNewDACL
= NULL
;
1835 PSECURITY_DESCRIPTOR pSD
= NULL
;
1837 TCHAR username
[100];
1840 /* Get current user, he will act as the owner */
1842 if (!GetUserName (username
, &unsize
))
1845 if (GetNamedSecurityInfo
1848 DACL_SECURITY_INFORMATION
,
1849 NULL
, NULL
, &pOldDACL
, NULL
, &pSD
) != ERROR_SUCCESS
)
1852 BuildExplicitAccessWithName
1853 (&ea
, username
, AccessPermissions
, (ACCESS_MODE
) AccessMode
, NO_INHERITANCE
);
1855 if (AccessMode
== SET_ACCESS
)
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
)
1863 if (SetEntriesInAcl (1, &ea
, pOldDACL
, &pNewDACL
) != ERROR_SUCCESS
)
1866 if (SetNamedSecurityInfo
1867 (wname
, SE_FILE_OBJECT
,
1868 DACL_SECURITY_INFORMATION
, NULL
, NULL
, pNewDACL
, NULL
) != ERROR_SUCCESS
)
1872 LocalFree (pNewDACL
);
1875 /* Check if it is possible to use ACL for wname, the file must not be on a
1879 __gnat_can_use_acl (TCHAR
*wname
)
1881 return __gnat_use_acl
&& GetDriveTypeFromPath (wname
) != DRIVE_REMOTE
;
1884 #endif /* defined (_WIN32) */
1887 __gnat_is_readable_file_attr (char* name
, struct file_attributes
* attr
)
1889 if (attr
->readable
== ATTR_UNSET
)
1891 #if defined (_WIN32)
1892 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1893 GENERIC_MAPPING GenericMapping
;
1895 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1897 if (__gnat_can_use_acl (wname
))
1899 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1900 GenericMapping
.GenericRead
= GENERIC_READ
;
1902 __gnat_check_OWNER_ACL (wname
, FILE_READ_DATA
, GenericMapping
);
1905 attr
->readable
= GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
;
1907 __gnat_stat_to_attr (-1, name
, attr
);
1911 return attr
->readable
;
1915 __gnat_is_readable_file (char *name
)
1917 struct file_attributes attr
;
1919 __gnat_reset_attributes (&attr
);
1920 return __gnat_is_readable_file_attr (name
, &attr
);
1924 __gnat_is_writable_file_attr (char* name
, struct file_attributes
* attr
)
1926 if (attr
->writable
== ATTR_UNSET
)
1928 #if defined (_WIN32)
1929 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1930 GENERIC_MAPPING GenericMapping
;
1932 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1934 if (__gnat_can_use_acl (wname
))
1936 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1937 GenericMapping
.GenericWrite
= GENERIC_WRITE
;
1939 attr
->writable
= __gnat_check_OWNER_ACL
1940 (wname
, FILE_WRITE_DATA
| FILE_APPEND_DATA
, GenericMapping
)
1941 && !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
1945 !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
1948 __gnat_stat_to_attr (-1, name
, attr
);
1952 return attr
->writable
;
1956 __gnat_is_writable_file (char *name
)
1958 struct file_attributes attr
;
1960 __gnat_reset_attributes (&attr
);
1961 return __gnat_is_writable_file_attr (name
, &attr
);
1965 __gnat_is_executable_file_attr (char* name
, struct file_attributes
* attr
)
1967 if (attr
->executable
== ATTR_UNSET
)
1969 #if defined (_WIN32)
1970 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1971 GENERIC_MAPPING GenericMapping
;
1973 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1975 if (__gnat_can_use_acl (wname
))
1977 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1978 GenericMapping
.GenericExecute
= GENERIC_EXECUTE
;
1981 __gnat_check_OWNER_ACL (wname
, FILE_EXECUTE
, GenericMapping
);
1985 TCHAR
*l
, *last
= _tcsstr(wname
, _T(".exe"));
1987 /* look for last .exe */
1989 while ((l
= _tcsstr(last
+1, _T(".exe"))))
1993 GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
1994 && (last
- wname
) == (int) (_tcslen (wname
) - 4);
1997 __gnat_stat_to_attr (-1, name
, attr
);
2001 return attr
->regular
&& attr
->executable
;
2005 __gnat_is_executable_file (char *name
)
2007 struct file_attributes attr
;
2009 __gnat_reset_attributes (&attr
);
2010 return __gnat_is_executable_file_attr (name
, &attr
);
2014 __gnat_set_writable (char *name
)
2016 #if defined (_WIN32)
2017 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2019 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2021 if (__gnat_can_use_acl (wname
))
2022 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_WRITE
);
2025 (wname
, GetFileAttributes (wname
) & ~FILE_ATTRIBUTE_READONLY
);
2026 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2027 GNAT_STRUCT_STAT statbuf
;
2029 if (GNAT_STAT (name
, &statbuf
) == 0)
2031 statbuf
.st_mode
= statbuf
.st_mode
| S_IWUSR
;
2032 chmod (name
, statbuf
.st_mode
);
2037 /* must match definition in s-os_lib.ads */
2043 __gnat_set_executable (char *name
, int mode ATTRIBUTE_UNUSED
)
2045 #if defined (_WIN32)
2046 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2048 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2050 if (__gnat_can_use_acl (wname
))
2051 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_EXECUTE
);
2053 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2054 GNAT_STRUCT_STAT statbuf
;
2056 if (GNAT_STAT (name
, &statbuf
) == 0)
2059 statbuf
.st_mode
= statbuf
.st_mode
| S_IXUSR
;
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
);
2070 __gnat_set_non_writable (char *name
)
2072 #if defined (_WIN32)
2073 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2075 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
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
);
2084 (wname
, GetFileAttributes (wname
) | FILE_ATTRIBUTE_READONLY
);
2085 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2086 GNAT_STRUCT_STAT statbuf
;
2088 if (GNAT_STAT (name
, &statbuf
) == 0)
2090 statbuf
.st_mode
= statbuf
.st_mode
& 07577;
2091 chmod (name
, statbuf
.st_mode
);
2097 __gnat_set_readable (char *name
)
2099 #if defined (_WIN32)
2100 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2102 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2104 if (__gnat_can_use_acl (wname
))
2105 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_READ
);
2107 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2108 GNAT_STRUCT_STAT statbuf
;
2110 if (GNAT_STAT (name
, &statbuf
) == 0)
2112 chmod (name
, statbuf
.st_mode
| S_IREAD
);
2118 __gnat_set_non_readable (char *name
)
2120 #if defined (_WIN32)
2121 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2123 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2125 if (__gnat_can_use_acl (wname
))
2126 __gnat_set_OWNER_ACL (wname
, DENY_ACCESS
, FILE_GENERIC_READ
);
2128 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2129 GNAT_STRUCT_STAT statbuf
;
2131 if (GNAT_STAT (name
, &statbuf
) == 0)
2133 chmod (name
, statbuf
.st_mode
& (~S_IREAD
));
2139 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED
,
2140 struct file_attributes
* attr
)
2142 if (attr
->symbolic_link
== ATTR_UNSET
)
2144 #if defined (__vxworks)
2145 attr
->symbolic_link
= 0;
2147 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2149 GNAT_STRUCT_STAT statbuf
;
2150 ret
= GNAT_LSTAT (name
, &statbuf
);
2151 attr
->symbolic_link
= (!ret
&& S_ISLNK (statbuf
.st_mode
));
2153 attr
->symbolic_link
= 0;
2156 return attr
->symbolic_link
;
2160 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED
)
2162 struct file_attributes attr
;
2164 __gnat_reset_attributes (&attr
);
2165 return __gnat_is_symbolic_link_attr (name
, &attr
);
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. */
2176 __gnat_portable_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2178 int status ATTRIBUTE_UNUSED
= 0;
2179 int finished ATTRIBUTE_UNUSED
;
2180 int pid ATTRIBUTE_UNUSED
;
2182 #if defined (__vxworks) || defined(__PikeOS__)
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], "\"");
2193 status
= spawnvp (P_WAIT
, args_0
, (char ** const)args
);
2195 /* restore previous value */
2197 args
[0] = (char *)args_0
;
2213 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2218 finished
= waitpid (pid
, &status
, 0);
2220 if (finished
!= pid
|| WIFEXITED (status
) == 0)
2223 return WEXITSTATUS (status
);
2229 /* Create a copy of the given file descriptor.
2230 Return -1 if an error occurred. */
2233 __gnat_dup (int oldfd
)
2235 #if defined (__vxworks) && !defined (__RTP__)
2236 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2244 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2245 Return -1 if an error occurred. */
2248 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED
, int newfd ATTRIBUTE_UNUSED
)
2250 #if defined (__vxworks) && !defined (__RTP__)
2251 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2254 #elif defined (__PikeOS__)
2255 /* Not supported. */
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)
2264 return dup2 (oldfd
, newfd
);
2266 return dup2 (oldfd
, newfd
);
2271 __gnat_number_of_cpus (void)
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
);
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
;
2285 #elif defined (_WIN32)
2286 SYSTEM_INFO sysinfo
;
2287 GetSystemInfo (&sysinfo
);
2288 cores
= (int) sysinfo
.dwNumberOfProcessors
;
2290 #elif defined (_WRS_CONFIG_SMP)
2291 unsigned int vxCpuConfiguredGet (void);
2293 cores
= vxCpuConfiguredGet ();
2300 /* WIN32 code to implement a wait call that wait for any child process. */
2302 #if defined (_WIN32)
2304 /* Synchronization code, to be thread safe. */
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). */
2312 static void EnterCS (void) {}
2313 static void LeaveCS (void) {}
2314 static void SignalListChanged (void) {}
2318 CRITICAL_SECTION ProcListCS
;
2319 HANDLE ProcListEvt
= NULL
;
2321 static void EnterCS (void)
2323 EnterCriticalSection(&ProcListCS
);
2326 static void LeaveCS (void)
2328 LeaveCriticalSection(&ProcListCS
);
2331 static void SignalListChanged (void)
2333 SetEvent (ProcListEvt
);
2338 static HANDLE
*HANDLES_LIST
= NULL
;
2339 static int *PID_LIST
= NULL
, plist_length
= 0, plist_max_length
= 0;
2342 add_handle (HANDLE h
, int pid
)
2344 /* -------------------- critical section -------------------- */
2347 if (plist_length
== plist_max_length
)
2349 plist_max_length
+= 100;
2351 (HANDLE
*) xrealloc (HANDLES_LIST
, sizeof (HANDLE
) * plist_max_length
);
2353 (int *) xrealloc (PID_LIST
, sizeof (int) * plist_max_length
);
2356 HANDLES_LIST
[plist_length
] = h
;
2357 PID_LIST
[plist_length
] = pid
;
2360 SignalListChanged();
2362 /* -------------------- critical section -------------------- */
2366 __gnat_win32_remove_handle (HANDLE h
, int pid
)
2371 /* -------------------- critical section -------------------- */
2374 for (j
= 0; j
< plist_length
; j
++)
2376 if ((HANDLES_LIST
[j
] == h
) || (PID_LIST
[j
] == pid
))
2380 HANDLES_LIST
[j
] = HANDLES_LIST
[plist_length
];
2381 PID_LIST
[j
] = PID_LIST
[plist_length
];
2388 /* -------------------- critical section -------------------- */
2391 SignalListChanged();
2397 win32_no_block_spawn (char *command
, char *args
[], HANDLE
*h
, int *pid
)
2401 PROCESS_INFORMATION PI
;
2402 SECURITY_ATTRIBUTES SA
;
2407 /* compute the total command line length */
2411 csize
+= strlen (args
[k
]) + 1;
2415 full_command
= (char *) xmalloc (csize
);
2418 SI
.cb
= sizeof (STARTUPINFO
);
2419 SI
.lpReserved
= NULL
;
2420 SI
.lpReserved2
= NULL
;
2421 SI
.lpDesktop
= NULL
;
2425 SI
.wShowWindow
= SW_HIDE
;
2427 /* Security attributes. */
2428 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
2429 SA
.bInheritHandle
= TRUE
;
2430 SA
.lpSecurityDescriptor
= NULL
;
2432 /* Prepare the command string. */
2433 strcpy (full_command
, command
);
2434 strcat (full_command
, " ");
2439 strcat (full_command
, args
[k
]);
2440 strcat (full_command
, " ");
2445 int wsize
= csize
* 2;
2446 TCHAR
*wcommand
= (TCHAR
*) xmalloc (wsize
);
2448 S2WSC (wcommand
, full_command
, wsize
);
2450 free (full_command
);
2452 result
= CreateProcess
2453 (NULL
, wcommand
, &SA
, NULL
, TRUE
,
2454 GetPriorityClass (GetCurrentProcess()), NULL
, NULL
, &SI
, &PI
);
2461 CloseHandle (PI
.hThread
);
2463 *pid
= PI
.dwProcessId
;
2473 win32_wait (int *status
)
2475 DWORD exitcode
, pid
;
2485 if (plist_length
== 0)
2491 /* -------------------- critical section -------------------- */
2494 hl_len
= plist_length
;
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
);
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
);
2513 /* -------------------- critical section -------------------- */
2515 res
= WaitForMultipleObjects (hl_len
, hl
, FALSE
, INFINITE
);
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 */
2520 if (res
- WAIT_OBJECT_0
== 0)
2527 h
= hl
[res
- WAIT_OBJECT_0
];
2528 GetExitCodeProcess (h
, &exitcode
);
2529 pid
= pidl
[res
- WAIT_OBJECT_0
];
2531 found
= __gnat_win32_remove_handle (h
, -1);
2536 /* if not found another process waiting has already handled this process */
2543 *status
= (int) exitcode
;
2550 __gnat_portable_no_block_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2553 #if defined (__vxworks) || defined (__PikeOS__)
2554 /* Not supported. */
2557 #elif defined (_WIN32)
2562 win32_no_block_spawn (args
[0], args
, &h
, &pid
);
2565 add_handle (h
, pid
);
2578 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2588 __gnat_portable_wait (int *process_status
)
2593 #if defined (__vxworks) || defined (__PikeOS__)
2594 /* Not sure what to do here, so do nothing but return zero. */
2596 #elif defined (_WIN32)
2598 pid
= win32_wait (&status
);
2602 pid
= waitpid (-1, &status
, 0);
2603 status
= status
& 0xffff;
2606 *process_status
= status
;
2611 __gnat_os_exit (int status
)
2617 __gnat_current_process_id (void)
2619 #if defined (__vxworks) || defined (__PikeOS__)
2622 #elif defined (_WIN32)
2624 return (int)GetCurrentProcessId();
2628 return (int)getpid();
2632 /* Locate file on path, that matches a predicate */
2635 __gnat_locate_file_with_predicate (char *file_name
, char *path_val
,
2636 int (*predicate
)(char *))
2639 char *file_path
= (char *) alloca (strlen (file_name
) + 1);
2642 /* Return immediately if file_name is empty */
2644 if (*file_name
== '\0')
2647 /* Remove quotes around file_name if present */
2653 strcpy (file_path
, ptr
);
2655 ptr
= file_path
+ strlen (file_path
) - 1;
2660 /* Handle absolute pathnames. */
2662 absolute
= __gnat_is_absolute_path (file_path
, strlen (file_name
));
2666 if (predicate (file_path
))
2667 return xstrdup (file_path
);
2672 /* If file_name include directory separator(s), try it first as
2673 a path name relative to the current directory */
2674 for (ptr
= file_name
; *ptr
&& *ptr
!= '/' && *ptr
!= DIR_SEPARATOR
; ptr
++)
2679 if (predicate (file_name
))
2680 return xstrdup (file_name
);
2687 /* The result has to be smaller than path_val + file_name. */
2689 (char *) alloca (strlen (path_val
) + strlen (file_name
) + 2);
2693 /* Skip the starting quote */
2695 if (*path_val
== '"')
2698 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
2699 *ptr
++ = *path_val
++;
2701 /* If directory is empty, it is the current directory*/
2703 if (ptr
== file_path
)
2710 /* Skip the ending quote */
2715 if (*ptr
!= '/' && *ptr
!= DIR_SEPARATOR
)
2716 *++ptr
= DIR_SEPARATOR
;
2718 strcpy (++ptr
, file_name
);
2720 if (predicate (file_path
))
2721 return xstrdup (file_path
);
2726 /* Skip path separator */
2735 /* Locate an executable file, give a Path value. */
2738 __gnat_locate_executable_file (char *file_name
, char *path_val
)
2740 return __gnat_locate_file_with_predicate
2741 (file_name
, path_val
, &__gnat_is_executable_file
);
2744 /* Locate a regular file, give a Path value. */
2747 __gnat_locate_regular_file (char *file_name
, char *path_val
)
2749 return __gnat_locate_file_with_predicate
2750 (file_name
, path_val
, &__gnat_is_regular_file
);
2753 /* Locate an executable given a Path argument. This routine is only used by
2754 gnatbl and should not be used otherwise. Use locate_exec_on_path
2758 __gnat_locate_exec (char *exec_name
, char *path_val
)
2761 if (!strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
2763 char *full_exec_name
=
2765 (strlen (exec_name
) + strlen (HOST_EXECUTABLE_SUFFIX
) + 1);
2767 strcpy (full_exec_name
, exec_name
);
2768 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
2769 ptr
= __gnat_locate_executable_file (full_exec_name
, path_val
);
2772 return __gnat_locate_executable_file (exec_name
, path_val
);
2776 return __gnat_locate_executable_file (exec_name
, path_val
);
2779 /* Locate an executable using the Systems default PATH. */
2782 __gnat_locate_exec_on_path (char *exec_name
)
2786 #if defined (_WIN32)
2787 TCHAR
*wpath_val
= _tgetenv (_T("PATH"));
2789 /* In Win32 systems we expand the PATH as for XP environment
2790 variables are not automatically expanded. We also prepend the
2791 ".;" to the path to match normal NT path search semantics */
2793 #define EXPAND_BUFFER_SIZE 32767
2795 wapath_val
= (TCHAR
*) alloca (EXPAND_BUFFER_SIZE
);
2797 wapath_val
[0] = '.';
2798 wapath_val
[1] = ';';
2800 DWORD res
= ExpandEnvironmentStrings
2801 (wpath_val
, &wapath_val
[2], EXPAND_BUFFER_SIZE
- 2);
2803 if (!res
) wapath_val
[0] = _T('\0');
2805 apath_val
= (char *) alloca (EXPAND_BUFFER_SIZE
);
2807 WS2SC (apath_val
, wapath_val
, EXPAND_BUFFER_SIZE
);
2810 const char *path_val
= getenv ("PATH");
2812 /* If PATH is not defined, proceed with __gnat_locate_exec anyway, so we can
2813 find files that contain directory names. */
2815 if (path_val
== NULL
) path_val
= "";
2816 apath_val
= (char *) alloca (strlen (path_val
) + 1);
2817 strcpy (apath_val
, path_val
);
2820 return __gnat_locate_exec (exec_name
, apath_val
);
2823 /* Dummy functions for Osint import for non-VMS systems.
2824 ??? To be removed. */
2827 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED
,
2828 int onlydirs ATTRIBUTE_UNUSED
)
2834 __gnat_to_canonical_file_list_next (void)
2836 static char empty
[] = "";
2841 __gnat_to_canonical_file_list_free (void)
2846 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2852 __gnat_to_canonical_file_spec (char *filespec
)
2858 __gnat_to_canonical_path_spec (char *pathspec
)
2864 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2870 __gnat_to_host_file_spec (char *filespec
)
2876 __gnat_adjust_os_resource_limits (void)
2880 #if defined (__mips_vxworks)
2884 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
2888 #if defined (_WIN32)
2889 int __gnat_argument_needs_quote
= 1;
2891 int __gnat_argument_needs_quote
= 0;
2894 /* This option is used to enable/disable object files handling from the
2895 binder file by the GNAT Project module. For example, this is disabled on
2896 Windows (prior to GCC 3.4) as it is already done by the mdll module.
2897 Stating with GCC 3.4 the shared libraries are not based on mdll
2898 anymore as it uses the GCC's -shared option */
2899 #if defined (_WIN32) \
2900 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
2901 int __gnat_prj_add_obj_files
= 0;
2903 int __gnat_prj_add_obj_files
= 1;
2906 /* char used as prefix/suffix for environment variables */
2907 #if defined (_WIN32)
2908 char __gnat_environment_char
= '%';
2910 char __gnat_environment_char
= '$';
2913 /* This functions copy the file attributes from a source file to a
2916 mode = 0 : In this mode copy only the file time stamps (last access and
2917 last modification time stamps).
2919 mode = 1 : In this mode, time stamps and read/write/execute attributes are
2922 mode = 2 : In this mode, only read/write/execute attributes are copied
2924 Returns 0 if operation was successful and -1 in case of error. */
2927 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED
, char *to ATTRIBUTE_UNUSED
,
2928 int mode ATTRIBUTE_UNUSED
)
2930 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2933 #elif defined (_WIN32)
2934 TCHAR wfrom
[GNAT_MAX_PATH_LEN
+ 2];
2935 TCHAR wto
[GNAT_MAX_PATH_LEN
+ 2];
2937 FILETIME fct
, flat
, flwt
;
2940 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
+ 2);
2941 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
+ 2);
2943 /* Do we need to copy the timestamp ? */
2946 /* retrieve from times */
2949 (wfrom
, GENERIC_READ
, 0, NULL
, OPEN_EXISTING
,
2950 FILE_ATTRIBUTE_NORMAL
, NULL
);
2952 if (hfrom
== INVALID_HANDLE_VALUE
)
2955 res
= GetFileTime (hfrom
, &fct
, &flat
, &flwt
);
2957 CloseHandle (hfrom
);
2962 /* retrieve from times */
2965 (wto
, GENERIC_WRITE
, 0, NULL
, OPEN_EXISTING
,
2966 FILE_ATTRIBUTE_NORMAL
, NULL
);
2968 if (hto
== INVALID_HANDLE_VALUE
)
2971 res
= SetFileTime (hto
, NULL
, &flat
, &flwt
);
2979 /* Do we need to copy the permissions ? */
2980 /* Set file attributes in full mode. */
2984 DWORD attribs
= GetFileAttributes (wfrom
);
2986 if (attribs
== INVALID_FILE_ATTRIBUTES
)
2989 res
= SetFileAttributes (wto
, attribs
);
2997 GNAT_STRUCT_STAT fbuf
;
2998 struct utimbuf tbuf
;
3000 if (GNAT_STAT (from
, &fbuf
) == -1) {
3004 /* Do we need to copy timestamp ? */
3006 tbuf
.actime
= fbuf
.st_atime
;
3007 tbuf
.modtime
= fbuf
.st_mtime
;
3009 if (utime (to
, &tbuf
) == -1) {
3014 /* Do we need to copy file permissions ? */
3015 if (mode
!= 0 && (chmod (to
, fbuf
.st_mode
) == -1)) {
3024 __gnat_lseek (int fd
, long offset
, int whence
)
3026 return (int) lseek (fd
, offset
, whence
);
3029 /* This function returns the major version number of GCC being used. */
3031 get_gcc_version (void)
3036 return (int) (version_string
[0] - '0');
3041 * Set Close_On_Exec as indicated.
3042 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
3046 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED
,
3047 int close_on_exec_p ATTRIBUTE_UNUSED
)
3049 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3050 int flags
= fcntl (fd
, F_GETFD
, 0);
3053 if (close_on_exec_p
)
3054 flags
|= FD_CLOEXEC
;
3056 flags
&= ~FD_CLOEXEC
;
3057 return fcntl (fd
, F_SETFD
, flags
);
3058 #elif defined(_WIN32)
3059 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
3060 if (h
== (HANDLE
) -1)
3062 if (close_on_exec_p
)
3063 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
, 0);
3064 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
,
3065 HANDLE_FLAG_INHERIT
);
3067 /* TODO: Unimplemented. */
3072 /* Indicates if platforms supports automatic initialization through the
3073 constructor mechanism */
3075 __gnat_binder_supports_auto_init (void)
3080 /* Indicates that Stand-Alone Libraries are automatically initialized through
3081 the constructor mechanism */
3083 __gnat_sals_init_using_constructors (void)
3085 #if defined (__vxworks) || defined (__Lynx__)
3092 #if defined (__linux__) || defined (__ANDROID__)
3093 /* There is no function in the glibc to retrieve the LWP of the current
3094 thread. We need to do a system call in order to retrieve this
3096 #include <sys/syscall.h>
3098 __gnat_lwp_self (void)
3100 return (void *) syscall (__NR_gettid
);
3104 #if defined (__APPLE__)
3105 #include <mach/thread_info.h>
3106 #include <mach/mach_init.h>
3107 #include <mach/thread_act.h>
3109 /* System-wide thread identifier. Note it could be truncated on 32 bit
3111 Previously was: pthread_mach_thread_np (pthread_self ()). */
3113 __gnat_lwp_self (void)
3115 thread_identifier_info_data_t data
;
3116 mach_msg_type_number_t count
= THREAD_IDENTIFIER_INFO_COUNT
;
3119 kret
= thread_info (mach_thread_self (), THREAD_IDENTIFIER_INFO
,
3120 (thread_info_t
) &data
, &count
);
3121 if (kret
== KERN_SUCCESS
)
3122 return (void *)(uintptr_t)data
.thread_id
;
3128 #if defined (__linux__)
3131 /* glibc versions earlier than 2.7 do not define the routines to handle
3132 dynamically allocated CPU sets. For these targets, we use the static
3137 /* Dynamic cpu sets */
3140 __gnat_cpu_alloc (size_t count
)
3142 return CPU_ALLOC (count
);
3146 __gnat_cpu_alloc_size (size_t count
)
3148 return CPU_ALLOC_SIZE (count
);
3152 __gnat_cpu_free (cpu_set_t
*set
)
3158 __gnat_cpu_zero (size_t count
, cpu_set_t
*set
)
3160 CPU_ZERO_S (count
, set
);
3164 __gnat_cpu_set (int cpu
, size_t count
, cpu_set_t
*set
)
3166 /* Ada handles CPU numbers starting from 1, while C identifies the first
3167 CPU by a 0, so we need to adjust. */
3168 CPU_SET_S (cpu
- 1, count
, set
);
3171 #else /* !CPU_ALLOC */
3173 /* Static cpu sets */
3176 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED
)
3178 return (cpu_set_t
*) xmalloc (sizeof (cpu_set_t
));
3182 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED
)
3184 return sizeof (cpu_set_t
);
3188 __gnat_cpu_free (cpu_set_t
*set
)
3194 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3200 __gnat_cpu_set (int cpu
, size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3202 /* Ada handles CPU numbers starting from 1, while C identifies the first
3203 CPU by a 0, so we need to adjust. */
3204 CPU_SET (cpu
- 1, set
);
3206 #endif /* !CPU_ALLOC */
3207 #endif /* __linux__ */
3209 /* Return the load address of the executable, or 0 if not known. In the
3210 specific case of error, (void *)-1 can be returned. Beware: this unit may
3211 be in a shared library. As low-level units are needed, we allow #include
3214 #if defined (__APPLE__)
3215 #include <mach-o/dyld.h>
3219 __gnat_get_executable_load_address (void)
3221 #if defined (__APPLE__)
3222 return _dyld_get_image_header (0);
3224 #elif 0 && defined (__linux__)
3225 /* Currently disabled as it needs at least -ldl. */
3226 struct link_map
*map
= _r_debug
.r_map
;
3228 return (const void *)map
->l_addr
;
3236 __gnat_kill (int pid
, int sig
, int close ATTRIBUTE_UNUSED
)
3239 HANDLE h
= OpenProcess (PROCESS_ALL_ACCESS
, FALSE
, pid
);
3244 TerminateProcess (h
, 1);
3246 else if (sig
== SIGINT
)
3247 GenerateConsoleCtrlEvent (CTRL_C_EVENT
, pid
);
3248 else if (sig
== SIGBREAK
)
3249 GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT
, pid
);
3250 /* ??? The last two alternatives don't really work. SIGBREAK requires setting
3251 up process groups at start time which we don't do; treating SIGINT is just
3252 not possible apparently. So we really only support signal 9. Fortunately
3253 that's all we use in GNAT.Expect */
3256 #elif defined (__vxworks)
3257 /* Not implemented */
3263 void __gnat_killprocesstree (int pid
, int sig_num
)
3269 memset(&pe
, 0, sizeof(PROCESSENTRY32
));
3270 pe
.dwSize
= sizeof(PROCESSENTRY32
);
3272 HANDLE hSnap
= CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS
, 0);
3274 /* cannot take snapshot, just kill the parent process */
3276 if (hSnap
== INVALID_HANDLE_VALUE
)
3278 __gnat_kill (pid
, sig_num
, 1);
3282 if (Process32First(hSnap
, &pe
))
3284 BOOL bContinue
= TRUE
;
3286 /* kill child processes first */
3290 if (pe
.th32ParentProcessID
== (int)pid
)
3291 __gnat_killprocesstree (pe
.th32ProcessID
, sig_num
);
3293 bContinue
= Process32Next (hSnap
, &pe
);
3297 CloseHandle (hSnap
);
3301 __gnat_kill (pid
, sig_num
, 1);
3303 #elif defined (__vxworks)
3304 /* not implemented */
3306 #elif defined (__linux__)
3310 /* read all processes' pid and ppid */
3312 dir
= opendir ("/proc");
3314 /* cannot open proc, just kill the parent process */
3318 __gnat_kill (pid
, sig_num
, 1);
3322 /* kill child processes first */
3324 while ((d
= readdir (dir
)) != NULL
)
3326 if ((d
->d_type
& DT_DIR
) == DT_DIR
)
3328 char statfile
[64] = { 0 };
3331 /* read /proc/<PID>/stat */
3333 strncpy (statfile
, "/proc/", sizeof(statfile
));
3334 strncat (statfile
, d
->d_name
, sizeof(statfile
));
3335 strncat (statfile
, "/stat", sizeof(statfile
));
3337 FILE *fd
= fopen (statfile
, "r");
3341 const int match
= fscanf (fd
, "%d %*s %*s %d", &_pid
, &_ppid
);
3344 if (match
== 2 && _ppid
== pid
)
3345 __gnat_killprocesstree (_pid
, sig_num
);
3354 __gnat_kill (pid
, sig_num
, 1);
3356 __gnat_kill (pid
, sig_num
, 1);
3358 /* Note on Solaris it is possible to read /proc/<PID>/status.
3359 The 5th and 6th words are the pid and the 7th and 8th the ppid.
3360 See: /usr/include/sys/procfs.h (struct pstatus).