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 (__DJGPP__)
117 /* For isalpha-like tests in the compiler, we're expected to resort to
118 safe-ctype.h/ISALPHA. This isn't available for the runtime library
119 build, so we fallback on ctype.h/isalpha there. */
123 #define ISALPHA isalpha
126 #elif defined (__MINGW32__) || defined (__CYGWIN__)
130 /* Current code page and CCS encoding to use, set in initialize.c. */
131 UINT CurrentCodePage
;
132 UINT CurrentCCSEncoding
;
134 #include <sys/utime.h>
136 /* For isalpha-like tests in the compiler, we're expected to resort to
137 safe-ctype.h/ISALPHA. This isn't available for the runtime library
138 build, so we fallback on ctype.h/isalpha there. */
142 #define ISALPHA isalpha
145 #elif defined (__Lynx__)
147 /* Lynx utime.h only defines the entities of interest to us if
148 defined (VMOS_DEV), so ... */
157 /* wait.h processing */
160 # include <sys/wait.h>
162 #elif defined (__vxworks) && defined (__RTP__)
164 #elif defined (__Lynx__)
165 /* ??? We really need wait.h and it includes resource.h on Lynx. GCC
166 has a resource.h header as well, included instead of the lynx
167 version in our setup, causing lots of errors. We don't really need
168 the lynx contents of this file, so just workaround the issue by
169 preventing the inclusion of the GCC header from doing anything. */
170 # define GCC_RESOURCE_H
171 # include <sys/wait.h>
172 #elif defined (__PikeOS__)
173 /* No wait() or waitpid() calls available. */
176 #include <sys/wait.h>
179 #if defined (__DJGPP__)
185 #define DIR_SEPARATOR '\\'
187 #elif defined (_WIN32)
192 #include <tlhelp32.h>
194 #define DIR_SEPARATOR '\\'
202 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
203 defined in the current system. On DOS-like systems these flags control
204 whether the file is opened/created in text-translation mode (CR/LF in
205 external file mapped to LF in internal file), but in Unix-like systems,
206 no text translation is required, so these flags have no effect. */
216 #ifndef HOST_EXECUTABLE_SUFFIX
217 #define HOST_EXECUTABLE_SUFFIX ""
220 #ifndef HOST_OBJECT_SUFFIX
221 #define HOST_OBJECT_SUFFIX ".o"
224 #ifndef PATH_SEPARATOR
225 #define PATH_SEPARATOR ':'
228 #ifndef DIR_SEPARATOR
229 #define DIR_SEPARATOR '/'
232 /* Check for cross-compilation. */
233 #if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
235 int __gnat_is_cross_compiler
= 1;
238 int __gnat_is_cross_compiler
= 0;
241 char __gnat_dir_separator
= DIR_SEPARATOR
;
243 char __gnat_path_separator
= PATH_SEPARATOR
;
245 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
246 the base filenames that libraries specified with -lsomelib options
247 may have. This is used by GNATMAKE to check whether an executable
248 is up-to-date or not. The syntax is
250 library_template ::= { pattern ; } pattern NUL
251 pattern ::= [ prefix ] * [ postfix ]
253 These should only specify names of static libraries as it makes
254 no sense to determine at link time if dynamic-link libraries are
255 up to date or not. Any libraries that are not found are supposed
258 * if they are needed but not present, the link
261 * otherwise they are libraries in the system paths and so
262 they are considered part of the system and not checked
265 ??? This should be part of a GNAT host-specific compiler
266 file instead of being included in all user applications
267 as well. This is only a temporary work-around for 3.11b. */
269 #ifndef GNAT_LIBRARY_TEMPLATE
270 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
273 const char *__gnat_library_template
= GNAT_LIBRARY_TEMPLATE
;
275 #if defined (__vxworks)
276 #define GNAT_MAX_PATH_LEN PATH_MAX
280 #if defined (__MINGW32__)
284 #include <sys/param.h>
288 #include <sys/param.h>
292 #define GNAT_MAX_PATH_LEN MAXPATHLEN
294 #define GNAT_MAX_PATH_LEN 256
299 /* Used for runtime check that Ada constant File_Attributes_Size is no
300 less than the actual size of struct file_attributes (see Osint
302 int __gnat_size_of_file_attributes
= sizeof (struct file_attributes
);
304 void __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
);
306 /* The __gnat_max_path_len variable is used to export the maximum
307 length of a path name to Ada code. max_path_len is also provided
308 for compatibility with older GNAT versions, please do not use
311 int __gnat_max_path_len
= GNAT_MAX_PATH_LEN
;
312 int max_path_len
= GNAT_MAX_PATH_LEN
;
314 /* Control whether we can use ACL on Windows. */
316 int __gnat_use_acl
= 1;
318 /* The following macro HAVE_READDIR_R should be defined if the
319 system provides the routine readdir_r.
320 ... but we never define it anywhere??? */
321 #undef HAVE_READDIR_R
323 #define MAYBE_TO_PTR32(argv) argv
325 static const char ATTR_UNSET
= 127;
327 /* Reset the file attributes as if no system call had been performed */
330 __gnat_reset_attributes (struct file_attributes
* attr
)
332 attr
->exists
= ATTR_UNSET
;
333 attr
->error
= EINVAL
;
335 attr
->writable
= ATTR_UNSET
;
336 attr
->readable
= ATTR_UNSET
;
337 attr
->executable
= ATTR_UNSET
;
339 attr
->regular
= ATTR_UNSET
;
340 attr
->symbolic_link
= ATTR_UNSET
;
341 attr
->directory
= ATTR_UNSET
;
343 attr
->timestamp
= (OS_Time
)-2;
344 attr
->file_length
= -1;
348 __gnat_error_attributes (struct file_attributes
*attr
) {
353 __gnat_current_time (void)
355 time_t res
= time (NULL
);
356 return (OS_Time
) res
;
359 /* Return the current local time as a string in the ISO 8601 format of
360 "YYYY-MM-DD HH:MM:SS.SS". The returned string is 22 + 1 (NULL) characters
364 __gnat_current_time_string (char *result
)
366 const char *format
= "%Y-%m-%d %H:%M:%S";
367 /* Format string necessary to describe the ISO 8601 format */
369 const time_t t_val
= time (NULL
);
371 strftime (result
, 22, format
, localtime (&t_val
));
372 /* Convert the local time into a string following the ISO format, copying
373 at most 22 characters into the result string. */
378 /* The sub-seconds are manually set to zero since type time_t lacks the
379 precision necessary for nanoseconds. */
383 __gnat_to_gm_time (OS_Time
*p_time
, int *p_year
, int *p_month
, int *p_day
,
384 int *p_hours
, int *p_mins
, int *p_secs
)
387 time_t time
= (time_t) *p_time
;
390 /* On Windows systems, the time is sometimes rounded up to the nearest
391 even second, so if the number of seconds is odd, increment it. */
396 res
= gmtime (&time
);
399 *p_year
= res
->tm_year
;
400 *p_month
= res
->tm_mon
;
401 *p_day
= res
->tm_mday
;
402 *p_hours
= res
->tm_hour
;
403 *p_mins
= res
->tm_min
;
404 *p_secs
= res
->tm_sec
;
407 *p_year
= *p_month
= *p_day
= *p_hours
= *p_mins
= *p_secs
= 0;
411 __gnat_to_os_time (OS_Time
*p_time
, int year
, int month
, int day
,
412 int hours
, int mins
, int secs
)
424 /* returns -1 of failing, this is s-os_lib Invalid_Time */
426 *p_time
= (OS_Time
) mktime (&v
);
429 /* Place the contents of the symbolic link named PATH in the buffer BUF,
430 which has size BUFSIZ. If PATH is a symbolic link, then return the number
431 of characters of its content in BUF. Otherwise, return -1.
432 For systems not supporting symbolic links, always return -1. */
435 __gnat_readlink (char *path ATTRIBUTE_UNUSED
,
436 char *buf ATTRIBUTE_UNUSED
,
437 size_t bufsiz ATTRIBUTE_UNUSED
)
439 #if defined (_WIN32) \
440 || defined(__vxworks) || defined (__PikeOS__)
443 return readlink (path
, buf
, bufsiz
);
447 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
448 If NEWPATH exists it will NOT be overwritten.
449 For systems not supporting symbolic links, always return -1. */
452 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED
,
453 char *newpath ATTRIBUTE_UNUSED
)
455 #if defined (_WIN32) \
456 || defined(__vxworks) || defined (__PikeOS__)
459 return symlink (oldpath
, newpath
);
463 /* Try to lock a file, return 1 if success. */
465 #if defined (__vxworks) \
466 || defined (_WIN32) || defined (__PikeOS__)
468 /* Version that does not use link. */
471 __gnat_try_lock (char *dir
, char *file
)
475 TCHAR wfull_path
[GNAT_MAX_PATH_LEN
];
476 TCHAR wfile
[GNAT_MAX_PATH_LEN
];
477 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
479 S2WSC (wdir
, dir
, GNAT_MAX_PATH_LEN
);
480 S2WSC (wfile
, file
, GNAT_MAX_PATH_LEN
);
482 /* ??? the code below crash on MingW64 for obscure reasons, a ticket
483 has been opened here:
485 https://sourceforge.net/p/mingw-w64/bugs/414/
487 As a workaround an equivalent set of code has been put in place below.
489 _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
492 _tcscpy (wfull_path
, wdir
);
493 _tcscat (wfull_path
, L
"\\");
494 _tcscat (wfull_path
, wfile
);
496 fd
= _topen (wfull_path
, O_CREAT
| O_EXCL
, 0600);
500 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
501 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
513 /* Version using link(), more secure over NFS. */
514 /* See TN 6913-016 for discussion ??? */
517 __gnat_try_lock (char *dir
, char *file
)
521 GNAT_STRUCT_STAT stat_result
;
524 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
525 sprintf (temp_file
, "%s%cTMP-%ld-%ld",
526 dir
, DIR_SEPARATOR
, (long)getpid(), (long)getppid ());
528 /* Create the temporary file and write the process number. */
529 fd
= open (temp_file
, O_CREAT
| O_WRONLY
, 0600);
535 /* Link it with the new file. */
536 link (temp_file
, full_path
);
538 /* Count the references on the old one. If we have a count of two, then
539 the link did succeed. Remove the temporary file before returning. */
540 __gnat_stat (temp_file
, &stat_result
);
542 return stat_result
.st_nlink
== 2;
546 /* Return the maximum file name length. */
549 __gnat_get_maximum_file_name_length (void)
554 /* Return nonzero if file names are case sensitive. */
556 static int file_names_case_sensitive_cache
= -1;
559 __gnat_get_file_names_case_sensitive (void)
561 if (file_names_case_sensitive_cache
== -1)
563 const char *sensitive
= getenv ("GNAT_FILE_NAME_CASE_SENSITIVE");
565 if (sensitive
!= NULL
566 && (sensitive
[0] == '0' || sensitive
[0] == '1')
567 && sensitive
[1] == '\0')
568 file_names_case_sensitive_cache
= sensitive
[0] - '0';
571 /* By default, we suppose filesystems aren't case sensitive on
572 Windows and Darwin (but they are on arm-darwin). */
573 #if defined (WINNT) || defined (__DJGPP__) \
574 || (defined (__APPLE__) && !(defined (__arm__) || defined (__arm64__)))
575 file_names_case_sensitive_cache
= 0;
577 file_names_case_sensitive_cache
= 1;
581 return file_names_case_sensitive_cache
;
584 /* Return nonzero if environment variables are case sensitive. */
587 __gnat_get_env_vars_case_sensitive (void)
589 #if defined (WINNT) || defined (__DJGPP__)
597 __gnat_get_default_identifier_character_set (void)
602 /* Return the current working directory. */
605 __gnat_get_current_dir (char *dir
, int *length
)
607 #if defined (__MINGW32__)
608 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
610 _tgetcwd (wdir
, *length
);
612 WS2SC (dir
, wdir
, GNAT_MAX_PATH_LEN
);
615 getcwd (dir
, *length
);
618 *length
= strlen (dir
);
620 if (dir
[*length
- 1] != DIR_SEPARATOR
)
622 dir
[*length
] = DIR_SEPARATOR
;
628 /* Return the suffix for object files. */
631 __gnat_get_object_suffix_ptr (int *len
, const char **value
)
633 *value
= HOST_OBJECT_SUFFIX
;
638 *len
= strlen (*value
);
643 /* Return the suffix for executable files. */
646 __gnat_get_executable_suffix_ptr (int *len
, const char **value
)
648 *value
= HOST_EXECUTABLE_SUFFIX
;
652 *len
= strlen (*value
);
657 /* Return the suffix for debuggable files. Usually this is the same as the
658 executable extension. */
661 __gnat_get_debuggable_suffix_ptr (int *len
, const char **value
)
663 *value
= HOST_EXECUTABLE_SUFFIX
;
668 *len
= strlen (*value
);
673 /* Returns the OS filename and corresponding encoding. */
676 __gnat_os_filename (char *filename ATTRIBUTE_UNUSED
,
677 char *w_filename ATTRIBUTE_UNUSED
,
678 char *os_name
, int *o_length
,
679 char *encoding ATTRIBUTE_UNUSED
, int *e_length
)
681 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
682 WS2SC (os_name
, (TCHAR
*)w_filename
, (DWORD
)*o_length
);
683 *o_length
= strlen (os_name
);
684 strcpy (encoding
, "encoding=utf8");
685 *e_length
= strlen (encoding
);
687 strcpy (os_name
, filename
);
688 *o_length
= strlen (filename
);
696 __gnat_unlink (char *path
)
698 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
700 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
702 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
703 return _tunlink (wpath
);
706 return unlink (path
);
713 __gnat_rename (char *from
, char *to
)
715 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
717 TCHAR wfrom
[GNAT_MAX_PATH_LEN
], wto
[GNAT_MAX_PATH_LEN
];
719 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
);
720 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
);
721 return _trename (wfrom
, wto
);
724 return rename (from
, to
);
728 /* Changing directory. */
731 __gnat_chdir (char *path
)
733 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
735 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
737 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
738 return _tchdir (wpath
);
745 /* Removing a directory. */
748 __gnat_rmdir (char *path
)
750 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
752 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
754 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
755 return _trmdir (wpath
);
757 #elif defined (VTHREADS)
758 /* rmdir not available */
765 #if defined (_WIN32) || defined (__linux__) || defined (__sun__) \
766 || defined (__FreeBSD__) || defined(__DragonFly__)
767 #define HAS_TARGET_WCHAR_T
770 #ifdef HAS_TARGET_WCHAR_T
775 __gnat_fputwc(int c
, FILE *stream
)
777 #ifdef HAS_TARGET_WCHAR_T
778 return fputwc ((wchar_t)c
, stream
);
780 return fputc (c
, stream
);
785 __gnat_fopen (char *path
, char *mode
, int encoding ATTRIBUTE_UNUSED
)
787 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
788 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
791 S2WS (wmode
, mode
, 10);
793 if (encoding
== Encoding_Unspecified
)
794 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
795 else if (encoding
== Encoding_UTF8
)
796 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
798 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
800 return _tfopen (wpath
, wmode
);
803 return GNAT_FOPEN (path
, mode
);
808 __gnat_freopen (char *path
,
811 int encoding ATTRIBUTE_UNUSED
)
813 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
814 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
817 S2WS (wmode
, mode
, 10);
819 if (encoding
== Encoding_Unspecified
)
820 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
821 else if (encoding
== Encoding_UTF8
)
822 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
824 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
826 return _tfreopen (wpath
, wmode
, stream
);
828 return freopen (path
, mode
, stream
);
833 __gnat_open_read (char *path
, int fmode
)
836 int o_fmode
= O_BINARY
;
841 #if defined (__vxworks)
842 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
843 #elif defined (__MINGW32__)
845 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
847 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
848 fd
= _topen (wpath
, O_RDONLY
| o_fmode
, 0444);
851 fd
= GNAT_OPEN (path
, O_RDONLY
| o_fmode
);
854 return fd
< 0 ? -1 : fd
;
857 #if defined (__MINGW32__)
858 #define PERM (S_IREAD | S_IWRITE)
860 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
864 __gnat_open_rw (char *path
, int fmode
)
867 int o_fmode
= O_BINARY
;
872 #if defined (__MINGW32__)
874 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
876 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
877 fd
= _topen (wpath
, O_RDWR
| o_fmode
, PERM
);
880 fd
= GNAT_OPEN (path
, O_RDWR
| o_fmode
, PERM
);
883 return fd
< 0 ? -1 : fd
;
887 __gnat_open_create (char *path
, int fmode
)
890 int o_fmode
= O_BINARY
;
895 #if defined (__MINGW32__)
897 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
899 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
900 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
903 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
906 return fd
< 0 ? -1 : fd
;
910 __gnat_create_output_file (char *path
)
913 #if defined (__MINGW32__)
915 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
917 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
918 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
921 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
924 return fd
< 0 ? -1 : fd
;
928 __gnat_create_output_file_new (char *path
)
931 #if defined (__MINGW32__)
933 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
935 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
936 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
939 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
942 return fd
< 0 ? -1 : fd
;
946 __gnat_open_append (char *path
, int fmode
)
949 int o_fmode
= O_BINARY
;
954 #if defined (__MINGW32__)
956 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
958 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
959 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
962 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
965 return fd
< 0 ? -1 : fd
;
968 /* Open a new file. Return error (-1) if the file already exists. */
971 __gnat_open_new (char *path
, int fmode
)
974 int o_fmode
= O_BINARY
;
979 #if defined (__MINGW32__)
981 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
983 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
984 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
987 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
990 return fd
< 0 ? -1 : fd
;
993 /* Open a new temp file. Return error (-1) if the file already exists. */
996 __gnat_open_new_temp (char *path
, int fmode
)
999 int o_fmode
= O_BINARY
;
1001 strcpy (path
, "GNAT-XXXXXX");
1003 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
1004 || defined (__linux__) || defined (__GLIBC__) || defined (__ANDROID__) \
1005 || defined (__DragonFly__)) && !defined (__vxworks)
1006 return mkstemp (path
);
1007 #elif defined (__Lynx__)
1010 if (mktemp (path
) == NULL
)
1017 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1018 return fd
< 0 ? -1 : fd
;
1022 __gnat_open (char *path
, int fmode
)
1026 #if defined (__MINGW32__)
1028 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1030 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1031 fd
= _topen (wpath
, fmode
, PERM
);
1034 fd
= GNAT_OPEN (path
, fmode
, PERM
);
1037 return fd
< 0 ? -1 : fd
;
1040 /****************************************************************
1041 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
1042 ** as possible from it, storing the result in a cache for later reuse
1043 ****************************************************************/
1046 __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
)
1048 GNAT_STRUCT_STAT statbuf
;
1052 /* GNAT_FSTAT returns -1 and sets errno for failure */
1053 ret
= GNAT_FSTAT (fd
, &statbuf
);
1054 error
= ret
? errno
: 0;
1057 /* __gnat_stat returns errno value directly */
1058 error
= __gnat_stat (name
, &statbuf
);
1059 ret
= error
? -1 : 0;
1063 * A missing file is reported as an attr structure with error == 0 and
1067 if (error
== 0 || error
== ENOENT
)
1070 attr
->error
= error
;
1072 attr
->regular
= (!ret
&& S_ISREG (statbuf
.st_mode
));
1073 attr
->directory
= (!ret
&& S_ISDIR (statbuf
.st_mode
));
1076 attr
->file_length
= 0;
1078 /* st_size may be 32 bits, or 64 bits which is converted to long. We
1079 don't return a useful value for files larger than 2 gigabytes in
1081 attr
->file_length
= statbuf
.st_size
; /* all systems */
1083 attr
->exists
= !ret
;
1085 #if !defined (_WIN32)
1086 /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
1087 attr
->readable
= (!ret
&& (statbuf
.st_mode
& S_IRUSR
));
1088 attr
->writable
= (!ret
&& (statbuf
.st_mode
& S_IWUSR
));
1089 attr
->executable
= (!ret
&& (statbuf
.st_mode
& S_IXUSR
));
1093 attr
->timestamp
= (OS_Time
)-1;
1095 attr
->timestamp
= (OS_Time
)statbuf
.st_mtime
;
1099 /****************************************************************
1100 ** Return the number of bytes in the specified file
1101 ****************************************************************/
1104 __gnat_file_length_attr (int fd
, char* name
, struct file_attributes
* attr
)
1106 if (attr
->file_length
== -1) {
1107 __gnat_stat_to_attr (fd
, name
, attr
);
1110 return attr
->file_length
;
1114 __gnat_file_length (int fd
)
1116 struct file_attributes attr
;
1117 __gnat_reset_attributes (&attr
);
1118 return __gnat_file_length_attr (fd
, NULL
, &attr
);
1122 __gnat_file_length_long (int fd
)
1124 struct file_attributes attr
;
1125 __gnat_reset_attributes (&attr
);
1126 return (long)__gnat_file_length_attr (fd
, NULL
, &attr
);
1130 __gnat_named_file_length (char *name
)
1132 struct file_attributes attr
;
1133 __gnat_reset_attributes (&attr
);
1134 return __gnat_file_length_attr (-1, name
, &attr
);
1137 /* Create a temporary filename and put it in string pointed to by
1141 __gnat_tmp_name (char *tmp_filename
)
1143 #if defined (__MINGW32__)
1148 /* tempnam tries to create a temporary file in directory pointed to by
1149 TMP environment variable, in c:\temp if TMP is not set, and in
1150 directory specified by P_tmpdir in stdio.h if c:\temp does not
1151 exist. The filename will be created with the prefix "gnat-". */
1153 sprintf (prefix
, "gnat-%d-", (int)getpid());
1154 pname
= (char *) _tempnam ("c:\\temp", prefix
);
1156 /* if pname is NULL, the file was not created properly, the disk is full
1157 or there is no more free temporary files */
1160 *tmp_filename
= '\0';
1162 /* If pname start with a back slash and not path information it means that
1163 the filename is valid for the current working directory. */
1165 else if (pname
[0] == '\\')
1167 strcpy (tmp_filename
, ".\\");
1168 strcat (tmp_filename
, pname
+1);
1171 strcpy (tmp_filename
, pname
);
1176 #elif defined (__linux__) || defined (__FreeBSD__) || defined (__NetBSD__) \
1177 || defined (__OpenBSD__) || defined (__GLIBC__) || defined (__ANDROID__) \
1178 || defined (__DragonFly__)
1179 #define MAX_SAFE_PATH 1000
1180 char *tmpdir
= getenv ("TMPDIR");
1182 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1183 a buffer overflow. */
1184 if (tmpdir
== NULL
|| strlen (tmpdir
) > MAX_SAFE_PATH
)
1186 strcpy (tmp_filename
, "/cache/gnat-XXXXXX");
1188 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
1191 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
1193 close (mkstemp(tmp_filename
));
1194 #elif defined (__vxworks) && !defined (VTHREADS)
1198 static ushort_t seed
= 0; /* used to generate unique name */
1200 /* Generate a unique name. */
1201 strcpy (tmp_filename
, "tmp");
1204 savepos
= pos
= tmp_filename
+ strlen (tmp_filename
) + index
;
1212 /* Fill up the name buffer from the last position. */
1214 for (t
= seed
; 0 <= --index
; t
>>= 3)
1215 *--pos
= '0' + (t
& 07);
1217 /* Check to see if its unique, if not bump the seed and try again. */
1218 f
= fopen (tmp_filename
, "r");
1226 tmpnam (tmp_filename
);
1230 /* Open directory and returns a DIR pointer. */
1232 DIR* __gnat_opendir (char *name
)
1234 #if defined (__MINGW32__)
1235 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1237 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1238 return (DIR*)_topendir (wname
);
1241 return opendir (name
);
1245 /* Read the next entry in a directory. The returned string points somewhere
1248 #if defined (__sun__)
1249 /* For Solaris, be sure to use the 64-bit version, otherwise NFS reads may
1250 fail with EOVERFLOW if the server uses 64-bit cookies. */
1251 #define dirent dirent64
1252 #define readdir readdir64
1256 __gnat_readdir (DIR *dirp
, char *buffer
, int *len
)
1258 #if defined (__MINGW32__)
1259 struct _tdirent
*dirent
= _treaddir ((_TDIR
*)dirp
);
1263 WS2SC (buffer
, dirent
->d_name
, GNAT_MAX_PATH_LEN
);
1264 *len
= strlen (buffer
);
1271 #elif defined (HAVE_READDIR_R)
1272 /* If possible, try to use the thread-safe version. */
1273 if (readdir_r (dirp
, buffer
) != NULL
)
1275 *len
= strlen (((struct dirent
*) buffer
)->d_name
);
1276 return ((struct dirent
*) buffer
)->d_name
;
1282 struct dirent
*dirent
= (struct dirent
*) readdir (dirp
);
1286 strcpy (buffer
, dirent
->d_name
);
1287 *len
= strlen (buffer
);
1296 /* Close a directory entry. */
1298 int __gnat_closedir (DIR *dirp
)
1300 #if defined (__MINGW32__)
1301 return _tclosedir ((_TDIR
*)dirp
);
1304 return closedir (dirp
);
1308 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1311 __gnat_readdir_is_thread_safe (void)
1313 #ifdef HAVE_READDIR_R
1320 #if defined (_WIN32)
1321 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1322 static const unsigned long long w32_epoch_offset
= 11644473600ULL;
1324 /* Returns the file modification timestamp using Win32 routines which are
1325 immune against daylight saving time change. It is in fact not possible to
1326 use fstat for this purpose as the DST modify the st_mtime field of the
1330 win32_filetime (HANDLE h
)
1335 unsigned long long ull_time
;
1338 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1339 since <Jan 1st 1601>. This function must return the number of seconds
1340 since <Jan 1st 1970>. */
1342 if (GetFileTime (h
, NULL
, NULL
, &t_write
.ft_time
))
1343 return (time_t) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1347 /* As above but starting from a FILETIME. */
1349 f2t (const FILETIME
*ft
, __time64_t
*t
)
1354 unsigned long long ull_time
;
1357 t_write
.ft_time
= *ft
;
1358 *t
= (__time64_t
) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1362 /* Return a GNAT time stamp given a file name. */
1365 __gnat_file_time_name_attr (char* name
, struct file_attributes
* attr
)
1367 if (attr
->timestamp
== (OS_Time
)-2) {
1368 #if defined (_WIN32)
1370 WIN32_FILE_ATTRIBUTE_DATA fad
;
1371 __time64_t ret
= -1;
1372 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1373 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1375 if ((res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
)))
1376 f2t (&fad
.ftLastWriteTime
, &ret
);
1377 attr
->timestamp
= (OS_Time
) ret
;
1379 __gnat_stat_to_attr (-1, name
, attr
);
1382 return attr
->timestamp
;
1386 __gnat_file_time_name (char *name
)
1388 struct file_attributes attr
;
1389 __gnat_reset_attributes (&attr
);
1390 return __gnat_file_time_name_attr (name
, &attr
);
1393 /* Return a GNAT time stamp given a file descriptor. */
1396 __gnat_file_time_fd_attr (int fd
, struct file_attributes
* attr
)
1398 if (attr
->timestamp
== (OS_Time
)-2) {
1399 #if defined (_WIN32)
1400 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
1401 time_t ret
= win32_filetime (h
);
1402 attr
->timestamp
= (OS_Time
) ret
;
1405 __gnat_stat_to_attr (fd
, NULL
, attr
);
1409 return attr
->timestamp
;
1413 __gnat_file_time_fd (int fd
)
1415 struct file_attributes attr
;
1416 __gnat_reset_attributes (&attr
);
1417 return __gnat_file_time_fd_attr (fd
, &attr
);
1420 /* Set the file time stamp. */
1423 __gnat_set_file_time_name (char *name
, time_t time_stamp
)
1425 #if defined (__vxworks)
1427 /* Code to implement __gnat_set_file_time_name for these systems. */
1429 #elif defined (_WIN32)
1433 unsigned long long ull_time
;
1435 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1437 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1439 HANDLE h
= CreateFile
1440 (wname
, GENERIC_WRITE
, FILE_SHARE_WRITE
, NULL
,
1441 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
,
1443 if (h
== INVALID_HANDLE_VALUE
)
1445 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1446 t_write
.ull_time
= ((unsigned long long)time_stamp
+ w32_epoch_offset
);
1447 /* Convert to 100 nanosecond units */
1448 t_write
.ull_time
*= 10000000ULL;
1450 SetFileTime(h
, NULL
, NULL
, &t_write
.ft_time
);
1455 struct utimbuf utimbuf
;
1458 /* Set modification time to requested time. */
1459 utimbuf
.modtime
= time_stamp
;
1461 /* Set access time to now in local time. */
1462 t
= time ((time_t) 0);
1463 utimbuf
.actime
= mktime (localtime (&t
));
1465 utime (name
, &utimbuf
);
1469 /* Get the list of installed standard libraries from the
1470 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1474 __gnat_get_libraries_from_registry (void)
1476 char *result
= (char *) xmalloc (1);
1480 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
1483 DWORD name_size
, value_size
;
1490 /* First open the key. */
1491 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1493 if (res
== ERROR_SUCCESS
)
1494 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1495 KEY_READ
, ®_key
);
1497 if (res
== ERROR_SUCCESS
)
1498 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1500 if (res
== ERROR_SUCCESS
)
1501 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1503 /* If the key exists, read out all the values in it and concatenate them
1505 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1507 value_size
= name_size
= 256;
1508 res
= RegEnumValueA (reg_key
, index
, name
, &name_size
, 0,
1509 &type
, (LPBYTE
)value
, &value_size
);
1511 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1513 char *old_result
= result
;
1515 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1516 strcpy (result
, old_result
);
1517 strcat (result
, value
);
1518 strcat (result
, ";");
1523 /* Remove the trailing ";". */
1525 result
[strlen (result
) - 1] = 0;
1531 /* Query information for the given file NAME and return it in STATBUF.
1532 * Returns 0 for success, or errno value for failure.
1535 __gnat_stat (char *name
, GNAT_STRUCT_STAT
*statbuf
)
1538 WIN32_FILE_ATTRIBUTE_DATA fad
;
1539 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1544 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1545 name_len
= _tcslen (wname
);
1547 if (name_len
> GNAT_MAX_PATH_LEN
)
1550 ZeroMemory (statbuf
, sizeof(GNAT_STRUCT_STAT
));
1552 res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
);
1555 error
= GetLastError();
1557 /* Check file existence using GetFileAttributes() which does not fail on
1558 special Windows files like con:, aux:, nul: etc... */
1560 if (GetFileAttributes(wname
) != INVALID_FILE_ATTRIBUTES
) {
1561 /* Just pretend that it is a regular and readable file */
1562 statbuf
->st_mode
= S_IFREG
| S_IREAD
| S_IWRITE
;
1567 case ERROR_ACCESS_DENIED
:
1568 case ERROR_SHARING_VIOLATION
:
1569 case ERROR_LOCK_VIOLATION
:
1570 case ERROR_SHARING_BUFFER_EXCEEDED
:
1572 case ERROR_BUFFER_OVERFLOW
:
1573 return ENAMETOOLONG
;
1574 case ERROR_NOT_ENOUGH_MEMORY
:
1581 f2t (&fad
.ftCreationTime
, &statbuf
->st_ctime
);
1582 f2t (&fad
.ftLastWriteTime
, &statbuf
->st_mtime
);
1583 f2t (&fad
.ftLastAccessTime
, &statbuf
->st_atime
);
1586 (__int64
)fad
.nFileSizeLow
| (__int64
)fad
.nFileSizeHigh
<< 32;
1588 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1589 statbuf
->st_mode
= S_IREAD
;
1591 if (fad
.dwFileAttributes
& FILE_ATTRIBUTE_DIRECTORY
)
1592 statbuf
->st_mode
|= S_IFDIR
;
1594 statbuf
->st_mode
|= S_IFREG
;
1596 if (!(fad
.dwFileAttributes
& FILE_ATTRIBUTE_READONLY
))
1597 statbuf
->st_mode
|= S_IWRITE
;
1602 return GNAT_STAT (name
, statbuf
) == 0 ? 0 : errno
;
1606 /*************************************************************************
1607 ** Check whether a file exists
1608 *************************************************************************/
1611 __gnat_file_exists_attr (char* name
, struct file_attributes
* attr
)
1613 if (attr
->exists
== ATTR_UNSET
)
1614 __gnat_stat_to_attr (-1, name
, attr
);
1616 return attr
->exists
;
1620 __gnat_file_exists (char *name
)
1622 struct file_attributes attr
;
1623 __gnat_reset_attributes (&attr
);
1624 return __gnat_file_exists_attr (name
, &attr
);
1627 /**********************************************************************
1628 ** Whether name is an absolute path
1629 **********************************************************************/
1632 __gnat_is_absolute_path (char *name
, int length
)
1635 /* On VxWorks systems, an absolute path can be represented (depending on
1636 the host platform) as either /dir/file, or device:/dir/file, or
1637 device:drive_letter:/dir/file. */
1644 for (index
= 0; index
< length
; index
++)
1646 if (name
[index
] == ':' &&
1647 ((name
[index
+ 1] == '/') ||
1648 (isalpha (name
[index
+ 1]) && index
+ 2 <= length
&&
1649 name
[index
+ 2] == '/')))
1652 else if (name
[index
] == '/')
1657 return (length
!= 0) &&
1658 (*name
== '/' || *name
== DIR_SEPARATOR
1659 #if defined (WINNT) || defined(__DJGPP__)
1660 || (length
> 1 && ISALPHA (name
[0]) && name
[1] == ':')
1667 __gnat_is_regular_file_attr (char* name
, struct file_attributes
* attr
)
1669 if (attr
->regular
== ATTR_UNSET
)
1670 __gnat_stat_to_attr (-1, name
, attr
);
1672 return attr
->regular
;
1676 __gnat_is_regular_file (char *name
)
1678 struct file_attributes attr
;
1680 __gnat_reset_attributes (&attr
);
1681 return __gnat_is_regular_file_attr (name
, &attr
);
1685 __gnat_is_regular_file_fd (int fd
)
1688 GNAT_STRUCT_STAT statbuf
;
1690 ret
= GNAT_FSTAT (fd
, &statbuf
);
1691 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1695 __gnat_is_directory_attr (char* name
, struct file_attributes
* attr
)
1697 if (attr
->directory
== ATTR_UNSET
)
1698 __gnat_stat_to_attr (-1, name
, attr
);
1700 return attr
->directory
;
1704 __gnat_is_directory (char *name
)
1706 struct file_attributes attr
;
1708 __gnat_reset_attributes (&attr
);
1709 return __gnat_is_directory_attr (name
, &attr
);
1712 #if defined (_WIN32)
1714 /* Returns the same constant as GetDriveType but takes a pathname as
1718 GetDriveTypeFromPath (TCHAR
*wfullpath
)
1720 TCHAR wdrv
[MAX_PATH
];
1721 TCHAR wpath
[MAX_PATH
];
1722 TCHAR wfilename
[MAX_PATH
];
1723 TCHAR wext
[MAX_PATH
];
1725 _tsplitpath (wfullpath
, wdrv
, wpath
, wfilename
, wext
);
1727 if (_tcslen (wdrv
) != 0)
1729 /* we have a drive specified. */
1730 _tcscat (wdrv
, _T("\\"));
1731 return GetDriveType (wdrv
);
1735 /* No drive specified. */
1737 /* Is this a relative path, if so get current drive type. */
1738 if (wpath
[0] != _T('\\') ||
1739 (_tcslen (wpath
) > 2 && wpath
[0] == _T('\\')
1740 && wpath
[1] != _T('\\')))
1741 return GetDriveType (NULL
);
1743 UINT result
= GetDriveType (wpath
);
1745 /* Cannot guess the drive type, is this \\.\ ? */
1747 if (result
== DRIVE_NO_ROOT_DIR
&&
1748 _tcslen (wpath
) >= 4 && wpath
[0] == _T('\\') && wpath
[1] == _T('\\')
1749 && wpath
[2] == _T('.') && wpath
[3] == _T('\\'))
1751 if (_tcslen (wpath
) == 4)
1752 _tcscat (wpath
, wfilename
);
1754 LPTSTR p
= &wpath
[4];
1755 LPTSTR b
= _tcschr (p
, _T('\\'));
1759 /* logical drive \\.\c\dir\file */
1765 _tcscat (p
, _T(":\\"));
1767 return GetDriveType (p
);
1774 /* This MingW section contains code to work with ACL. */
1776 __gnat_check_OWNER_ACL (TCHAR
*wname
,
1777 DWORD CheckAccessDesired
,
1778 GENERIC_MAPPING CheckGenericMapping
)
1780 DWORD dwAccessDesired
, dwAccessAllowed
;
1781 PRIVILEGE_SET PrivilegeSet
;
1782 DWORD dwPrivSetSize
= sizeof (PRIVILEGE_SET
);
1783 BOOL fAccessGranted
= FALSE
;
1784 HANDLE hToken
= NULL
;
1786 PSECURITY_DESCRIPTOR pSD
= NULL
;
1789 (wname
, OWNER_SECURITY_INFORMATION
|
1790 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1793 if ((pSD
= (SECURITY_DESCRIPTOR
*) HeapAlloc
1794 (GetProcessHeap (), HEAP_ZERO_MEMORY
, nLength
)) == NULL
)
1797 /* Obtain the security descriptor. */
1799 if (!GetFileSecurity
1800 (wname
, OWNER_SECURITY_INFORMATION
|
1801 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1802 pSD
, nLength
, &nLength
))
1805 if (!ImpersonateSelf (SecurityImpersonation
))
1808 if (!OpenThreadToken
1809 (GetCurrentThread(), TOKEN_DUPLICATE
| TOKEN_QUERY
, FALSE
, &hToken
))
1812 /* Undoes the effect of ImpersonateSelf. */
1816 /* We want to test for write permissions. */
1818 dwAccessDesired
= CheckAccessDesired
;
1820 MapGenericMask (&dwAccessDesired
, &CheckGenericMapping
);
1823 (pSD
, /* security descriptor to check */
1824 hToken
, /* impersonation token */
1825 dwAccessDesired
, /* requested access rights */
1826 &CheckGenericMapping
, /* pointer to GENERIC_MAPPING */
1827 &PrivilegeSet
, /* receives privileges used in check */
1828 &dwPrivSetSize
, /* size of PrivilegeSet buffer */
1829 &dwAccessAllowed
, /* receives mask of allowed access rights */
1833 CloseHandle (hToken
);
1834 HeapFree (GetProcessHeap (), 0, pSD
);
1835 return fAccessGranted
;
1839 CloseHandle (hToken
);
1840 HeapFree (GetProcessHeap (), 0, pSD
);
1845 __gnat_set_OWNER_ACL (TCHAR
*wname
,
1846 ACCESS_MODE AccessMode
,
1847 DWORD AccessPermissions
)
1849 PACL pOldDACL
= NULL
;
1850 PACL pNewDACL
= NULL
;
1851 PSECURITY_DESCRIPTOR pSD
= NULL
;
1853 TCHAR username
[100];
1856 /* Get current user, he will act as the owner */
1858 if (!GetUserName (username
, &unsize
))
1861 if (GetNamedSecurityInfo
1864 DACL_SECURITY_INFORMATION
,
1865 NULL
, NULL
, &pOldDACL
, NULL
, &pSD
) != ERROR_SUCCESS
)
1868 BuildExplicitAccessWithName
1869 (&ea
, username
, AccessPermissions
, (ACCESS_MODE
) AccessMode
, NO_INHERITANCE
);
1871 if (AccessMode
== SET_ACCESS
)
1873 /* SET_ACCESS, we want to set an explicte set of permissions, do not
1874 merge with current DACL. */
1875 if (SetEntriesInAcl (1, &ea
, NULL
, &pNewDACL
) != ERROR_SUCCESS
)
1879 if (SetEntriesInAcl (1, &ea
, pOldDACL
, &pNewDACL
) != ERROR_SUCCESS
)
1882 if (SetNamedSecurityInfo
1883 (wname
, SE_FILE_OBJECT
,
1884 DACL_SECURITY_INFORMATION
, NULL
, NULL
, pNewDACL
, NULL
) != ERROR_SUCCESS
)
1888 LocalFree (pNewDACL
);
1891 /* Check if it is possible to use ACL for wname, the file must not be on a
1895 __gnat_can_use_acl (TCHAR
*wname
)
1897 return __gnat_use_acl
&& GetDriveTypeFromPath (wname
) != DRIVE_REMOTE
;
1900 #endif /* defined (_WIN32) */
1903 __gnat_is_readable_file_attr (char* name
, struct file_attributes
* attr
)
1905 if (attr
->readable
== ATTR_UNSET
)
1907 #if defined (_WIN32)
1908 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1909 GENERIC_MAPPING GenericMapping
;
1911 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1913 if (__gnat_can_use_acl (wname
))
1915 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1916 GenericMapping
.GenericRead
= GENERIC_READ
;
1918 __gnat_check_OWNER_ACL (wname
, FILE_READ_DATA
, GenericMapping
);
1921 attr
->readable
= GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
;
1923 __gnat_stat_to_attr (-1, name
, attr
);
1927 return attr
->readable
;
1931 __gnat_is_read_accessible_file (char *name
)
1933 #if defined (_WIN32)
1934 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1936 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1938 return !_waccess (wname
, 4);
1940 #elif defined (__vxworks)
1943 if ((fd
= open (name
, O_RDONLY
, 0)) < 0)
1949 return !access (name
, R_OK
);
1954 __gnat_is_readable_file (char *name
)
1956 struct file_attributes attr
;
1958 __gnat_reset_attributes (&attr
);
1959 return __gnat_is_readable_file_attr (name
, &attr
);
1963 __gnat_is_writable_file_attr (char* name
, struct file_attributes
* attr
)
1965 if (attr
->writable
== ATTR_UNSET
)
1967 #if defined (_WIN32)
1968 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1969 GENERIC_MAPPING GenericMapping
;
1971 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1973 if (__gnat_can_use_acl (wname
))
1975 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1976 GenericMapping
.GenericWrite
= GENERIC_WRITE
;
1978 attr
->writable
= __gnat_check_OWNER_ACL
1979 (wname
, FILE_WRITE_DATA
| FILE_APPEND_DATA
, GenericMapping
)
1980 && !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
1984 !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
1987 __gnat_stat_to_attr (-1, name
, attr
);
1991 return attr
->writable
;
1995 __gnat_is_writable_file (char *name
)
1997 struct file_attributes attr
;
1999 __gnat_reset_attributes (&attr
);
2000 return __gnat_is_writable_file_attr (name
, &attr
);
2004 __gnat_is_write_accessible_file (char *name
)
2006 #if defined (_WIN32)
2007 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2009 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2011 return !_waccess (wname
, 2);
2013 #elif defined (__vxworks)
2016 if ((fd
= open (name
, O_WRONLY
, 0)) < 0)
2022 return !access (name
, W_OK
);
2027 __gnat_is_executable_file_attr (char* name
, struct file_attributes
* attr
)
2029 if (attr
->executable
== ATTR_UNSET
)
2031 #if defined (_WIN32)
2032 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2033 GENERIC_MAPPING GenericMapping
;
2035 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2037 if (__gnat_can_use_acl (wname
))
2039 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2040 GenericMapping
.GenericExecute
= GENERIC_EXECUTE
;
2043 __gnat_check_OWNER_ACL (wname
, FILE_EXECUTE
, GenericMapping
);
2047 TCHAR
*l
, *last
= _tcsstr(wname
, _T(".exe"));
2049 /* look for last .exe */
2051 while ((l
= _tcsstr(last
+1, _T(".exe"))))
2055 GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
2056 && (last
- wname
) == (int) (_tcslen (wname
) - 4);
2059 __gnat_stat_to_attr (-1, name
, attr
);
2063 return attr
->regular
&& attr
->executable
;
2067 __gnat_is_executable_file (char *name
)
2069 struct file_attributes attr
;
2071 __gnat_reset_attributes (&attr
);
2072 return __gnat_is_executable_file_attr (name
, &attr
);
2076 __gnat_set_writable (char *name
)
2078 #if defined (_WIN32)
2079 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2081 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2083 if (__gnat_can_use_acl (wname
))
2084 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_WRITE
);
2087 (wname
, GetFileAttributes (wname
) & ~FILE_ATTRIBUTE_READONLY
);
2088 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2089 GNAT_STRUCT_STAT statbuf
;
2091 if (GNAT_STAT (name
, &statbuf
) == 0)
2093 statbuf
.st_mode
= statbuf
.st_mode
| S_IWUSR
;
2094 chmod (name
, statbuf
.st_mode
);
2099 /* must match definition in s-os_lib.ads */
2105 __gnat_set_executable (char *name
, int mode ATTRIBUTE_UNUSED
)
2107 #if defined (_WIN32)
2108 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2110 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2112 if (__gnat_can_use_acl (wname
))
2113 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_EXECUTE
);
2115 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2116 GNAT_STRUCT_STAT statbuf
;
2118 if (GNAT_STAT (name
, &statbuf
) == 0)
2121 statbuf
.st_mode
= statbuf
.st_mode
| S_IXUSR
;
2123 statbuf
.st_mode
= statbuf
.st_mode
| S_IXGRP
;
2124 if (mode
& S_OTHERS
)
2125 statbuf
.st_mode
= statbuf
.st_mode
| S_IXOTH
;
2126 chmod (name
, statbuf
.st_mode
);
2132 __gnat_set_non_writable (char *name
)
2134 #if defined (_WIN32)
2135 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2137 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2139 if (__gnat_can_use_acl (wname
))
2140 __gnat_set_OWNER_ACL
2141 (wname
, DENY_ACCESS
,
2142 FILE_WRITE_DATA
| FILE_APPEND_DATA
|
2143 FILE_WRITE_EA
| FILE_WRITE_ATTRIBUTES
);
2146 (wname
, GetFileAttributes (wname
) | FILE_ATTRIBUTE_READONLY
);
2147 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2148 GNAT_STRUCT_STAT statbuf
;
2150 if (GNAT_STAT (name
, &statbuf
) == 0)
2152 statbuf
.st_mode
= statbuf
.st_mode
& 07577;
2153 chmod (name
, statbuf
.st_mode
);
2159 __gnat_set_readable (char *name
)
2161 #if defined (_WIN32)
2162 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2164 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2166 if (__gnat_can_use_acl (wname
))
2167 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_READ
);
2169 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2170 GNAT_STRUCT_STAT statbuf
;
2172 if (GNAT_STAT (name
, &statbuf
) == 0)
2174 chmod (name
, statbuf
.st_mode
| S_IREAD
);
2180 __gnat_set_non_readable (char *name
)
2182 #if defined (_WIN32)
2183 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2185 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2187 if (__gnat_can_use_acl (wname
))
2188 __gnat_set_OWNER_ACL (wname
, DENY_ACCESS
, FILE_GENERIC_READ
);
2190 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2191 GNAT_STRUCT_STAT statbuf
;
2193 if (GNAT_STAT (name
, &statbuf
) == 0)
2195 chmod (name
, statbuf
.st_mode
& (~S_IREAD
));
2201 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED
,
2202 struct file_attributes
* attr
)
2204 if (attr
->symbolic_link
== ATTR_UNSET
)
2206 #if defined (__vxworks)
2207 attr
->symbolic_link
= 0;
2209 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2211 GNAT_STRUCT_STAT statbuf
;
2212 ret
= GNAT_LSTAT (name
, &statbuf
);
2213 attr
->symbolic_link
= (!ret
&& S_ISLNK (statbuf
.st_mode
));
2215 attr
->symbolic_link
= 0;
2218 return attr
->symbolic_link
;
2222 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED
)
2224 struct file_attributes attr
;
2226 __gnat_reset_attributes (&attr
);
2227 return __gnat_is_symbolic_link_attr (name
, &attr
);
2230 #if defined (__sun__)
2231 /* Using fork on Solaris will duplicate all the threads. fork1, which
2232 duplicates only the active thread, must be used instead, or spawning
2233 subprocess from a program with tasking will lead into numerous problems. */
2238 __gnat_portable_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2240 int status ATTRIBUTE_UNUSED
= 0;
2241 int finished ATTRIBUTE_UNUSED
;
2242 int pid ATTRIBUTE_UNUSED
;
2244 #if defined (__vxworks) || defined(__PikeOS__)
2247 #elif defined (__DJGPP__) || defined (_WIN32)
2248 /* args[0] must be quotes as it could contain a full pathname with spaces */
2249 char *args_0
= args
[0];
2250 args
[0] = (char *)xmalloc (strlen (args_0
) + 3);
2251 strcpy (args
[0], "\"");
2252 strcat (args
[0], args_0
);
2253 strcat (args
[0], "\"");
2255 status
= spawnvp (P_WAIT
, args_0
, (char ** const)args
);
2257 /* restore previous value */
2259 args
[0] = (char *)args_0
;
2275 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2280 finished
= waitpid (pid
, &status
, 0);
2282 if (finished
!= pid
|| WIFEXITED (status
) == 0)
2285 return WEXITSTATUS (status
);
2291 /* Create a copy of the given file descriptor.
2292 Return -1 if an error occurred. */
2295 __gnat_dup (int oldfd
)
2297 #if defined (__vxworks) && !defined (__RTP__)
2298 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2306 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2307 Return -1 if an error occurred. */
2310 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED
, int newfd ATTRIBUTE_UNUSED
)
2312 #if defined (__vxworks) && !defined (__RTP__)
2313 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2316 #elif defined (__PikeOS__)
2317 /* Not supported. */
2319 #elif defined (_WIN32)
2320 /* Special case when oldfd and newfd are identical and are the standard
2321 input, output or error as this makes Windows XP hangs. Note that we
2322 do that only for standard file descriptors that are known to be valid. */
2323 if (oldfd
== newfd
&& newfd
>= 0 && newfd
<= 2)
2326 return dup2 (oldfd
, newfd
);
2328 return dup2 (oldfd
, newfd
);
2333 __gnat_number_of_cpus (void)
2337 #if defined (__linux__) || defined (__sun__) || defined (_AIX) \
2338 || defined (__APPLE__) || defined (__FreeBSD__) || defined (__OpenBSD__) \
2339 || defined (__DragonFly__) || defined (__NetBSD__)
2340 cores
= (int) sysconf (_SC_NPROCESSORS_ONLN
);
2342 #elif defined (__hpux__)
2343 struct pst_dynamic psd
;
2344 if (pstat_getdynamic (&psd
, sizeof (psd
), 1, 0) != -1)
2345 cores
= (int) psd
.psd_proc_cnt
;
2347 #elif defined (_WIN32)
2348 SYSTEM_INFO sysinfo
;
2349 GetSystemInfo (&sysinfo
);
2350 cores
= (int) sysinfo
.dwNumberOfProcessors
;
2352 #elif defined (_WRS_CONFIG_SMP)
2353 unsigned int vxCpuConfiguredGet (void);
2355 cores
= vxCpuConfiguredGet ();
2362 /* WIN32 code to implement a wait call that wait for any child process. */
2364 #if defined (_WIN32)
2366 /* Synchronization code, to be thread safe. */
2370 /* For the Cert run times on native Windows we use dummy functions
2371 for locking and unlocking tasks since we do not support multiple
2372 threads on this configuration (Cert run time on native Windows). */
2374 static void EnterCS (void) {}
2375 static void LeaveCS (void) {}
2376 static void SignalListChanged (void) {}
2380 CRITICAL_SECTION ProcListCS
;
2381 HANDLE ProcListEvt
= NULL
;
2383 static void EnterCS (void)
2385 EnterCriticalSection(&ProcListCS
);
2388 static void LeaveCS (void)
2390 LeaveCriticalSection(&ProcListCS
);
2393 static void SignalListChanged (void)
2395 SetEvent (ProcListEvt
);
2400 static HANDLE
*HANDLES_LIST
= NULL
;
2401 static int *PID_LIST
= NULL
, plist_length
= 0, plist_max_length
= 0;
2404 add_handle (HANDLE h
, int pid
)
2406 /* -------------------- critical section -------------------- */
2409 if (plist_length
== plist_max_length
)
2411 plist_max_length
+= 100;
2413 (HANDLE
*) xrealloc (HANDLES_LIST
, sizeof (HANDLE
) * plist_max_length
);
2415 (int *) xrealloc (PID_LIST
, sizeof (int) * plist_max_length
);
2418 HANDLES_LIST
[plist_length
] = h
;
2419 PID_LIST
[plist_length
] = pid
;
2422 SignalListChanged();
2424 /* -------------------- critical section -------------------- */
2428 __gnat_win32_remove_handle (HANDLE h
, int pid
)
2433 /* -------------------- critical section -------------------- */
2436 for (j
= 0; j
< plist_length
; j
++)
2438 if ((HANDLES_LIST
[j
] == h
) || (PID_LIST
[j
] == pid
))
2442 HANDLES_LIST
[j
] = HANDLES_LIST
[plist_length
];
2443 PID_LIST
[j
] = PID_LIST
[plist_length
];
2450 /* -------------------- critical section -------------------- */
2453 SignalListChanged();
2459 win32_no_block_spawn (char *command
, char *args
[], HANDLE
*h
, int *pid
)
2463 PROCESS_INFORMATION PI
;
2464 SECURITY_ATTRIBUTES SA
;
2469 /* compute the total command line length */
2473 csize
+= strlen (args
[k
]) + 1;
2477 full_command
= (char *) xmalloc (csize
);
2480 SI
.cb
= sizeof (STARTUPINFO
);
2481 SI
.lpReserved
= NULL
;
2482 SI
.lpReserved2
= NULL
;
2483 SI
.lpDesktop
= NULL
;
2487 SI
.wShowWindow
= SW_HIDE
;
2489 /* Security attributes. */
2490 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
2491 SA
.bInheritHandle
= TRUE
;
2492 SA
.lpSecurityDescriptor
= NULL
;
2494 /* Prepare the command string. */
2495 strcpy (full_command
, command
);
2496 strcat (full_command
, " ");
2501 strcat (full_command
, args
[k
]);
2502 strcat (full_command
, " ");
2507 int wsize
= csize
* 2;
2508 TCHAR
*wcommand
= (TCHAR
*) xmalloc (wsize
);
2510 S2WSC (wcommand
, full_command
, wsize
);
2512 free (full_command
);
2514 result
= CreateProcess
2515 (NULL
, wcommand
, &SA
, NULL
, TRUE
,
2516 GetPriorityClass (GetCurrentProcess()), NULL
, NULL
, &SI
, &PI
);
2523 CloseHandle (PI
.hThread
);
2525 *pid
= PI
.dwProcessId
;
2535 win32_wait (int *status
)
2537 DWORD exitcode
, pid
;
2547 if (plist_length
== 0)
2553 /* -------------------- critical section -------------------- */
2556 hl_len
= plist_length
;
2559 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
);
2560 memmove (hl
, HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2561 pidl
= (int *) xmalloc (sizeof (int) * hl_len
);
2562 memmove (pidl
, PID_LIST
, sizeof (int) * hl_len
);
2564 /* Note that index 0 contains the event handle that is signaled when the
2565 process list has changed */
2566 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
+ 1);
2567 hl
[0] = ProcListEvt
;
2568 memmove (&hl
[1], HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2569 pidl
= (int *) xmalloc (sizeof (int) * hl_len
+ 1);
2570 memmove (&pidl
[1], PID_LIST
, sizeof (int) * hl_len
);
2575 /* -------------------- critical section -------------------- */
2577 res
= WaitForMultipleObjects (hl_len
, hl
, FALSE
, INFINITE
);
2579 /* if the ProcListEvt has been signaled then the list of processes has been
2580 updated to add or remove a handle, just loop over */
2582 if (res
- WAIT_OBJECT_0
== 0)
2589 h
= hl
[res
- WAIT_OBJECT_0
];
2590 GetExitCodeProcess (h
, &exitcode
);
2591 pid
= pidl
[res
- WAIT_OBJECT_0
];
2593 found
= __gnat_win32_remove_handle (h
, -1);
2598 /* if not found another process waiting has already handled this process */
2605 *status
= (int) exitcode
;
2612 __gnat_portable_no_block_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2615 #if defined (__vxworks) || defined (__PikeOS__)
2616 /* Not supported. */
2619 #elif defined(__DJGPP__)
2620 if (spawnvp (P_WAIT
, args
[0], args
) != 0)
2625 #elif defined (_WIN32)
2630 win32_no_block_spawn (args
[0], args
, &h
, &pid
);
2633 add_handle (h
, pid
);
2646 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2656 __gnat_portable_wait (int *process_status
)
2661 #if defined (__vxworks) || defined (__PikeOS__)
2662 /* Not sure what to do here, so do nothing but return zero. */
2664 #elif defined (_WIN32)
2666 pid
= win32_wait (&status
);
2668 #elif defined (__DJGPP__)
2669 /* Child process has already ended in case of DJGPP.
2670 No need to do anything. Just return success. */
2673 pid
= waitpid (-1, &status
, 0);
2674 status
= status
& 0xffff;
2677 *process_status
= status
;
2682 __gnat_os_exit (int status
)
2688 __gnat_current_process_id (void)
2690 #if defined (__vxworks) || defined (__PikeOS__)
2693 #elif defined (_WIN32)
2695 return (int)GetCurrentProcessId();
2699 return (int)getpid();
2703 /* Locate file on path, that matches a predicate */
2706 __gnat_locate_file_with_predicate (char *file_name
, char *path_val
,
2707 int (*predicate
)(char *))
2710 char *file_path
= (char *) alloca (strlen (file_name
) + 1);
2713 /* Return immediately if file_name is empty */
2715 if (*file_name
== '\0')
2718 /* Remove quotes around file_name if present */
2724 strcpy (file_path
, ptr
);
2726 ptr
= file_path
+ strlen (file_path
) - 1;
2731 /* Handle absolute pathnames. */
2733 absolute
= __gnat_is_absolute_path (file_path
, strlen (file_name
));
2737 if (predicate (file_path
))
2738 return xstrdup (file_path
);
2743 /* If file_name include directory separator(s), try it first as
2744 a path name relative to the current directory */
2745 for (ptr
= file_name
; *ptr
&& *ptr
!= '/' && *ptr
!= DIR_SEPARATOR
; ptr
++)
2750 if (predicate (file_name
))
2751 return xstrdup (file_name
);
2758 /* The result has to be smaller than path_val + file_name. */
2760 (char *) alloca (strlen (path_val
) + strlen (file_name
) + 2);
2764 /* Skip the starting quote */
2766 if (*path_val
== '"')
2769 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
2770 *ptr
++ = *path_val
++;
2772 /* If directory is empty, it is the current directory*/
2774 if (ptr
== file_path
)
2781 /* Skip the ending quote */
2786 if (*ptr
!= '/' && *ptr
!= DIR_SEPARATOR
)
2787 *++ptr
= DIR_SEPARATOR
;
2789 strcpy (++ptr
, file_name
);
2791 if (predicate (file_path
))
2792 return xstrdup (file_path
);
2797 /* Skip path separator */
2806 /* Locate an executable file, give a Path value. */
2809 __gnat_locate_executable_file (char *file_name
, char *path_val
)
2811 return __gnat_locate_file_with_predicate
2812 (file_name
, path_val
, &__gnat_is_executable_file
);
2815 /* Locate a regular file, give a Path value. */
2818 __gnat_locate_regular_file (char *file_name
, char *path_val
)
2820 return __gnat_locate_file_with_predicate
2821 (file_name
, path_val
, &__gnat_is_regular_file
);
2824 /* Locate an executable given a Path argument. This routine is only used by
2825 gnatbl and should not be used otherwise. Use locate_exec_on_path
2829 __gnat_locate_exec (char *exec_name
, char *path_val
)
2832 if (!strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
2834 char *full_exec_name
=
2836 (strlen (exec_name
) + strlen (HOST_EXECUTABLE_SUFFIX
) + 1);
2838 strcpy (full_exec_name
, exec_name
);
2839 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
2840 ptr
= __gnat_locate_executable_file (full_exec_name
, path_val
);
2843 return __gnat_locate_executable_file (exec_name
, path_val
);
2847 return __gnat_locate_executable_file (exec_name
, path_val
);
2850 /* Locate an executable using the Systems default PATH. */
2853 __gnat_locate_exec_on_path (char *exec_name
)
2857 #if defined (_WIN32)
2858 TCHAR
*wpath_val
= _tgetenv (_T("PATH"));
2860 /* In Win32 systems we expand the PATH as for XP environment
2861 variables are not automatically expanded. We also prepend the
2862 ".;" to the path to match normal NT path search semantics */
2864 #define EXPAND_BUFFER_SIZE 32767
2866 wapath_val
= (TCHAR
*) alloca (EXPAND_BUFFER_SIZE
);
2868 wapath_val
[0] = '.';
2869 wapath_val
[1] = ';';
2871 DWORD res
= ExpandEnvironmentStrings
2872 (wpath_val
, &wapath_val
[2], EXPAND_BUFFER_SIZE
- 2);
2874 if (!res
) wapath_val
[0] = _T('\0');
2876 apath_val
= (char *) alloca (EXPAND_BUFFER_SIZE
);
2878 WS2SC (apath_val
, wapath_val
, EXPAND_BUFFER_SIZE
);
2881 const char *path_val
= getenv ("PATH");
2883 /* If PATH is not defined, proceed with __gnat_locate_exec anyway, so we can
2884 find files that contain directory names. */
2886 if (path_val
== NULL
) path_val
= "";
2887 apath_val
= (char *) alloca (strlen (path_val
) + 1);
2888 strcpy (apath_val
, path_val
);
2891 return __gnat_locate_exec (exec_name
, apath_val
);
2894 /* Dummy functions for Osint import for non-VMS systems.
2895 ??? To be removed. */
2898 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED
,
2899 int onlydirs ATTRIBUTE_UNUSED
)
2905 __gnat_to_canonical_file_list_next (void)
2907 static char empty
[] = "";
2912 __gnat_to_canonical_file_list_free (void)
2917 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2923 __gnat_to_canonical_file_spec (char *filespec
)
2929 __gnat_to_canonical_path_spec (char *pathspec
)
2935 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2941 __gnat_to_host_file_spec (char *filespec
)
2947 __gnat_adjust_os_resource_limits (void)
2951 #if defined (__mips_vxworks)
2955 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
2959 #if defined (_WIN32)
2960 int __gnat_argument_needs_quote
= 1;
2962 int __gnat_argument_needs_quote
= 0;
2965 /* This option is used to enable/disable object files handling from the
2966 binder file by the GNAT Project module. For example, this is disabled on
2967 Windows (prior to GCC 3.4) as it is already done by the mdll module.
2968 Stating with GCC 3.4 the shared libraries are not based on mdll
2969 anymore as it uses the GCC's -shared option */
2970 #if defined (_WIN32) \
2971 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
2972 int __gnat_prj_add_obj_files
= 0;
2974 int __gnat_prj_add_obj_files
= 1;
2977 /* char used as prefix/suffix for environment variables */
2978 #if defined (_WIN32)
2979 char __gnat_environment_char
= '%';
2981 char __gnat_environment_char
= '$';
2984 /* This functions copy the file attributes from a source file to a
2987 mode = 0 : In this mode copy only the file time stamps (last access and
2988 last modification time stamps).
2990 mode = 1 : In this mode, time stamps and read/write/execute attributes are
2993 mode = 2 : In this mode, only read/write/execute attributes are copied
2995 Returns 0 if operation was successful and -1 in case of error. */
2998 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED
, char *to ATTRIBUTE_UNUSED
,
2999 int mode ATTRIBUTE_UNUSED
)
3001 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
3004 #elif defined (_WIN32)
3005 TCHAR wfrom
[GNAT_MAX_PATH_LEN
+ 2];
3006 TCHAR wto
[GNAT_MAX_PATH_LEN
+ 2];
3008 FILETIME fct
, flat
, flwt
;
3011 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
+ 2);
3012 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
+ 2);
3014 /* Do we need to copy the timestamp ? */
3017 /* retrieve from times */
3020 (wfrom
, GENERIC_READ
, 0, NULL
, OPEN_EXISTING
,
3021 FILE_ATTRIBUTE_NORMAL
, NULL
);
3023 if (hfrom
== INVALID_HANDLE_VALUE
)
3026 res
= GetFileTime (hfrom
, &fct
, &flat
, &flwt
);
3028 CloseHandle (hfrom
);
3033 /* retrieve from times */
3036 (wto
, GENERIC_WRITE
, 0, NULL
, OPEN_EXISTING
,
3037 FILE_ATTRIBUTE_NORMAL
, NULL
);
3039 if (hto
== INVALID_HANDLE_VALUE
)
3042 res
= SetFileTime (hto
, NULL
, &flat
, &flwt
);
3050 /* Do we need to copy the permissions ? */
3051 /* Set file attributes in full mode. */
3055 DWORD attribs
= GetFileAttributes (wfrom
);
3057 if (attribs
== INVALID_FILE_ATTRIBUTES
)
3060 res
= SetFileAttributes (wto
, attribs
);
3068 GNAT_STRUCT_STAT fbuf
;
3069 struct utimbuf tbuf
;
3071 if (GNAT_STAT (from
, &fbuf
) == -1) {
3075 /* Do we need to copy timestamp ? */
3077 tbuf
.actime
= fbuf
.st_atime
;
3078 tbuf
.modtime
= fbuf
.st_mtime
;
3080 if (utime (to
, &tbuf
) == -1) {
3085 /* Do we need to copy file permissions ? */
3086 if (mode
!= 0 && (chmod (to
, fbuf
.st_mode
) == -1)) {
3095 __gnat_lseek (int fd
, long offset
, int whence
)
3097 return (int) lseek (fd
, offset
, whence
);
3100 /* This function returns the major version number of GCC being used. */
3102 get_gcc_version (void)
3107 return (int) (version_string
[0] - '0');
3112 * Set Close_On_Exec as indicated.
3113 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
3117 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED
,
3118 int close_on_exec_p ATTRIBUTE_UNUSED
)
3120 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3121 int flags
= fcntl (fd
, F_GETFD
, 0);
3124 if (close_on_exec_p
)
3125 flags
|= FD_CLOEXEC
;
3127 flags
&= ~FD_CLOEXEC
;
3128 return fcntl (fd
, F_SETFD
, flags
);
3129 #elif defined(_WIN32)
3130 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
3131 if (h
== (HANDLE
) -1)
3133 if (close_on_exec_p
)
3134 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
, 0);
3135 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
,
3136 HANDLE_FLAG_INHERIT
);
3138 /* TODO: Unimplemented. */
3143 /* Indicates if platforms supports automatic initialization through the
3144 constructor mechanism */
3146 __gnat_binder_supports_auto_init (void)
3151 /* Indicates that Stand-Alone Libraries are automatically initialized through
3152 the constructor mechanism */
3154 __gnat_sals_init_using_constructors (void)
3156 #if defined (__vxworks) || defined (__Lynx__)
3163 #if defined (__linux__) || defined (__ANDROID__)
3164 /* There is no function in the glibc to retrieve the LWP of the current
3165 thread. We need to do a system call in order to retrieve this
3167 #include <sys/syscall.h>
3169 __gnat_lwp_self (void)
3171 return (void *) syscall (__NR_gettid
);
3175 #if defined (__APPLE__)
3176 #include <mach/thread_info.h>
3177 #include <mach/mach_init.h>
3178 #include <mach/thread_act.h>
3180 /* System-wide thread identifier. Note it could be truncated on 32 bit
3182 Previously was: pthread_mach_thread_np (pthread_self ()). */
3184 __gnat_lwp_self (void)
3186 thread_identifier_info_data_t data
;
3187 mach_msg_type_number_t count
= THREAD_IDENTIFIER_INFO_COUNT
;
3190 kret
= thread_info (mach_thread_self (), THREAD_IDENTIFIER_INFO
,
3191 (thread_info_t
) &data
, &count
);
3192 if (kret
== KERN_SUCCESS
)
3193 return (void *)(uintptr_t)data
.thread_id
;
3199 #if defined (__linux__)
3202 /* glibc versions earlier than 2.7 do not define the routines to handle
3203 dynamically allocated CPU sets. For these targets, we use the static
3208 /* Dynamic cpu sets */
3211 __gnat_cpu_alloc (size_t count
)
3213 return CPU_ALLOC (count
);
3217 __gnat_cpu_alloc_size (size_t count
)
3219 return CPU_ALLOC_SIZE (count
);
3223 __gnat_cpu_free (cpu_set_t
*set
)
3229 __gnat_cpu_zero (size_t count
, cpu_set_t
*set
)
3231 CPU_ZERO_S (count
, set
);
3235 __gnat_cpu_set (int cpu
, size_t count
, cpu_set_t
*set
)
3237 /* Ada handles CPU numbers starting from 1, while C identifies the first
3238 CPU by a 0, so we need to adjust. */
3239 CPU_SET_S (cpu
- 1, count
, set
);
3242 #else /* !CPU_ALLOC */
3244 /* Static cpu sets */
3247 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED
)
3249 return (cpu_set_t
*) xmalloc (sizeof (cpu_set_t
));
3253 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED
)
3255 return sizeof (cpu_set_t
);
3259 __gnat_cpu_free (cpu_set_t
*set
)
3265 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3271 __gnat_cpu_set (int cpu
, size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3273 /* Ada handles CPU numbers starting from 1, while C identifies the first
3274 CPU by a 0, so we need to adjust. */
3275 CPU_SET (cpu
- 1, set
);
3277 #endif /* !CPU_ALLOC */
3278 #endif /* __linux__ */
3280 /* Return the load address of the executable, or 0 if not known. In the
3281 specific case of error, (void *)-1 can be returned. Beware: this unit may
3282 be in a shared library. As low-level units are needed, we allow #include
3285 #if defined (__APPLE__)
3286 #include <mach-o/dyld.h>
3290 __gnat_get_executable_load_address (void)
3292 #if defined (__APPLE__)
3293 return _dyld_get_image_header (0);
3295 #elif 0 && defined (__linux__)
3296 /* Currently disabled as it needs at least -ldl. */
3297 struct link_map
*map
= _r_debug
.r_map
;
3299 return (const void *)map
->l_addr
;
3307 __gnat_kill (int pid
, int sig
, int close ATTRIBUTE_UNUSED
)
3310 HANDLE h
= OpenProcess (PROCESS_ALL_ACCESS
, FALSE
, pid
);
3315 TerminateProcess (h
, 1);
3317 else if (sig
== SIGINT
)
3318 GenerateConsoleCtrlEvent (CTRL_C_EVENT
, pid
);
3319 else if (sig
== SIGBREAK
)
3320 GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT
, pid
);
3321 /* ??? The last two alternatives don't really work. SIGBREAK requires setting
3322 up process groups at start time which we don't do; treating SIGINT is just
3323 not possible apparently. So we really only support signal 9. Fortunately
3324 that's all we use in GNAT.Expect */
3327 #elif defined (__vxworks)
3328 /* Not implemented */
3334 void __gnat_killprocesstree (int pid
, int sig_num
)
3339 memset(&pe
, 0, sizeof(PROCESSENTRY32
));
3340 pe
.dwSize
= sizeof(PROCESSENTRY32
);
3342 HANDLE hSnap
= CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS
, 0);
3344 /* cannot take snapshot, just kill the parent process */
3346 if (hSnap
== INVALID_HANDLE_VALUE
)
3348 __gnat_kill (pid
, sig_num
, 1);
3352 if (Process32First(hSnap
, &pe
))
3354 BOOL bContinue
= TRUE
;
3356 /* kill child processes first */
3360 if (pe
.th32ParentProcessID
== (DWORD
)pid
)
3361 __gnat_killprocesstree (pe
.th32ProcessID
, sig_num
);
3363 bContinue
= Process32Next (hSnap
, &pe
);
3367 CloseHandle (hSnap
);
3371 __gnat_kill (pid
, sig_num
, 1);
3373 #elif defined (__vxworks)
3374 /* not implemented */
3376 #elif defined (__linux__)
3380 /* read all processes' pid and ppid */
3382 dir
= opendir ("/proc");
3384 /* cannot open proc, just kill the parent process */
3388 __gnat_kill (pid
, sig_num
, 1);
3392 /* kill child processes first */
3394 while ((d
= readdir (dir
)) != NULL
)
3396 if ((d
->d_type
& DT_DIR
) == DT_DIR
)
3398 char statfile
[64] = { 0 };
3401 /* read /proc/<PID>/stat */
3403 strncpy (statfile
, "/proc/", sizeof(statfile
));
3404 strncat (statfile
, d
->d_name
, sizeof(statfile
));
3405 strncat (statfile
, "/stat", sizeof(statfile
));
3407 FILE *fd
= fopen (statfile
, "r");
3411 const int match
= fscanf (fd
, "%d %*s %*s %d", &_pid
, &_ppid
);
3414 if (match
== 2 && _ppid
== pid
)
3415 __gnat_killprocesstree (_pid
, sig_num
);
3424 __gnat_kill (pid
, sig_num
, 1);
3426 __gnat_kill (pid
, sig_num
, 1);
3428 /* Note on Solaris it is possible to read /proc/<PID>/status.
3429 The 5th and 6th words are the pid and the 7th and 8th the ppid.
3430 See: /usr/include/sys/procfs.h (struct pstatus).