1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2019, 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 */
43 #define _LARGEFILE64_SOURCE 1
44 #elif !defined(_LARGEFILE_SOURCE)
45 #define _LARGEFILE_SOURCE
47 #define _FILE_OFFSET_BITS 64
51 /* No need to redefine exit here. */
54 /* We want to use the POSIX variants of include files. */
58 #if defined (__mips_vxworks)
60 #endif /* __mips_vxworks */
62 /* If SMP, access vxCpuConfiguredGet */
63 #ifdef _WRS_CONFIG_SMP
65 #endif /* _WRS_CONFIG_SMP */
67 /* We need to know the VxWorks version because some file operations
68 (such as chmod) are only available on VxWorks 6. */
73 #if defined (__APPLE__)
77 #if defined (__hpux__)
78 #include <sys/param.h>
79 #include <sys/pstat.h>
83 #define __BSD_VISIBLE 1
87 #include <sys/syspage.h>
94 #include <sys/types.h>
100 /* for CPU_SET/CPU_ZERO */
111 #include <sys/stat.h>
115 #if defined (__vxworks) || defined (__ANDROID__)
116 /* S_IREAD and S_IWRITE are not defined in VxWorks or Android */
118 #define S_IREAD (S_IRUSR | S_IRGRP | S_IROTH)
122 #define S_IWRITE (S_IWUSR)
126 /* We don't have libiberty, so use malloc. */
127 #define xmalloc(S) malloc (S)
128 #define xrealloc(V,S) realloc (V,S)
139 #if defined (__DJGPP__)
141 /* For isalpha-like tests in the compiler, we're expected to resort to
142 safe-ctype.h/ISALPHA. This isn't available for the runtime library
143 build, so we fallback on ctype.h/isalpha there. */
147 #define ISALPHA isalpha
150 #elif defined (__MINGW32__) || defined (__CYGWIN__)
154 /* Current code page and CCS encoding to use, set in initialize.c. */
155 UINT __gnat_current_codepage
;
156 UINT __gnat_current_ccs_encoding
;
158 #include <sys/utime.h>
160 /* For isalpha-like tests in the compiler, we're expected to resort to
161 safe-ctype.h/ISALPHA. This isn't available for the runtime library
162 build, so we fallback on ctype.h/isalpha there. */
166 #define ISALPHA isalpha
169 #elif defined (__Lynx__)
171 /* Lynx utime.h only defines the entities of interest to us if
172 defined (VMOS_DEV), so ... */
181 /* wait.h processing */
184 # include <sys/wait.h>
186 #elif defined (__vxworks) && defined (__RTP__)
188 #elif defined (__Lynx__)
189 /* ??? We really need wait.h and it includes resource.h on Lynx. GCC
190 has a resource.h header as well, included instead of the lynx
191 version in our setup, causing lots of errors. We don't really need
192 the lynx contents of this file, so just workaround the issue by
193 preventing the inclusion of the GCC header from doing anything. */
194 # define GCC_RESOURCE_H
195 # include <sys/wait.h>
196 #elif defined (__PikeOS__)
197 /* No wait() or waitpid() calls available. */
200 #include <sys/wait.h>
203 #if defined (__DJGPP__)
209 #define DIR_SEPARATOR '\\'
211 #elif defined (_WIN32)
216 #include <tlhelp32.h>
219 #define DIR_SEPARATOR '\\'
227 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
228 defined in the current system. On DOS-like systems these flags control
229 whether the file is opened/created in text-translation mode (CR/LF in
230 external file mapped to LF in internal file), but in Unix-like systems,
231 no text translation is required, so these flags have no effect. */
241 #ifndef HOST_EXECUTABLE_SUFFIX
242 #define HOST_EXECUTABLE_SUFFIX ""
245 #ifndef HOST_OBJECT_SUFFIX
246 #define HOST_OBJECT_SUFFIX ".o"
249 #ifndef PATH_SEPARATOR
250 #define PATH_SEPARATOR ':'
253 #ifndef DIR_SEPARATOR
254 #define DIR_SEPARATOR '/'
257 /* Check for cross-compilation. */
258 #if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
260 int __gnat_is_cross_compiler
= 1;
263 int __gnat_is_cross_compiler
= 0;
266 char __gnat_dir_separator
= DIR_SEPARATOR
;
268 char __gnat_path_separator
= PATH_SEPARATOR
;
270 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
271 the base filenames that libraries specified with -lsomelib options
272 may have. This is used by GNATMAKE to check whether an executable
273 is up-to-date or not. The syntax is
275 library_template ::= { pattern ; } pattern NUL
276 pattern ::= [ prefix ] * [ postfix ]
278 These should only specify names of static libraries as it makes
279 no sense to determine at link time if dynamic-link libraries are
280 up to date or not. Any libraries that are not found are supposed
283 * if they are needed but not present, the link
286 * otherwise they are libraries in the system paths and so
287 they are considered part of the system and not checked
290 ??? This should be part of a GNAT host-specific compiler
291 file instead of being included in all user applications
292 as well. This is only a temporary work-around for 3.11b. */
294 #ifndef GNAT_LIBRARY_TEMPLATE
295 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
298 const char *__gnat_library_template
= GNAT_LIBRARY_TEMPLATE
;
300 #if defined (__vxworks)
301 #define GNAT_MAX_PATH_LEN PATH_MAX
305 #if defined (__MINGW32__)
309 #include <sys/param.h>
313 #include <sys/param.h>
317 #define GNAT_MAX_PATH_LEN MAXPATHLEN
319 #define GNAT_MAX_PATH_LEN 256
324 /* Used for runtime check that Ada constant File_Attributes_Size is no
325 less than the actual size of struct file_attributes (see Osint
327 int __gnat_size_of_file_attributes
= sizeof (struct file_attributes
);
329 void __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
);
331 /* The __gnat_max_path_len variable is used to export the maximum
332 length of a path name to Ada code. max_path_len is also provided
333 for compatibility with older GNAT versions, please do not use
336 int __gnat_max_path_len
= GNAT_MAX_PATH_LEN
;
337 int max_path_len
= GNAT_MAX_PATH_LEN
;
339 /* Control whether we can use ACL on Windows. */
341 int __gnat_use_acl
= 1;
343 /* The following macro HAVE_READDIR_R should be defined if the
344 system provides the routine readdir_r.
345 ... but we never define it anywhere??? */
346 #undef HAVE_READDIR_R
348 #define MAYBE_TO_PTR32(argv) argv
350 static const char ATTR_UNSET
= 127;
352 /* Reset the file attributes as if no system call had been performed */
355 __gnat_reset_attributes (struct file_attributes
* attr
)
357 attr
->exists
= ATTR_UNSET
;
358 attr
->error
= EINVAL
;
360 attr
->writable
= ATTR_UNSET
;
361 attr
->readable
= ATTR_UNSET
;
362 attr
->executable
= ATTR_UNSET
;
364 attr
->regular
= ATTR_UNSET
;
365 attr
->symbolic_link
= ATTR_UNSET
;
366 attr
->directory
= ATTR_UNSET
;
368 attr
->timestamp
= (OS_Time
)-2;
369 attr
->file_length
= -1;
373 __gnat_error_attributes (struct file_attributes
*attr
) {
378 __gnat_current_time (void)
380 time_t res
= time (NULL
);
381 return (OS_Time
) res
;
384 /* Return the current local time as a string in the ISO 8601 format of
385 "YYYY-MM-DD HH:MM:SS.SS". The returned string is 22 + 1 (NULL) characters
389 __gnat_current_time_string (char *result
)
391 const char *format
= "%Y-%m-%d %H:%M:%S";
392 /* Format string necessary to describe the ISO 8601 format */
394 const time_t t_val
= time (NULL
);
396 strftime (result
, 22, format
, localtime (&t_val
));
397 /* Convert the local time into a string following the ISO format, copying
398 at most 22 characters into the result string. */
403 /* The sub-seconds are manually set to zero since type time_t lacks the
404 precision necessary for nanoseconds. */
408 __gnat_to_gm_time (OS_Time
*p_time
, int *p_year
, int *p_month
, int *p_day
,
409 int *p_hours
, int *p_mins
, int *p_secs
)
412 time_t time
= (time_t) *p_time
;
415 /* On Windows systems, the time is sometimes rounded up to the nearest
416 even second, so if the number of seconds is odd, increment it. */
421 res
= gmtime (&time
);
424 *p_year
= res
->tm_year
;
425 *p_month
= res
->tm_mon
;
426 *p_day
= res
->tm_mday
;
427 *p_hours
= res
->tm_hour
;
428 *p_mins
= res
->tm_min
;
429 *p_secs
= res
->tm_sec
;
432 *p_year
= *p_month
= *p_day
= *p_hours
= *p_mins
= *p_secs
= 0;
436 __gnat_to_os_time (OS_Time
*p_time
, int year
, int month
, int day
,
437 int hours
, int mins
, int secs
)
449 /* returns -1 of failing, this is s-os_lib Invalid_Time */
451 *p_time
= (OS_Time
) mktime (&v
);
454 /* Place the contents of the symbolic link named PATH in the buffer BUF,
455 which has size BUFSIZ. If PATH is a symbolic link, then return the number
456 of characters of its content in BUF. Otherwise, return -1.
457 For systems not supporting symbolic links, always return -1. */
460 __gnat_readlink (char *path ATTRIBUTE_UNUSED
,
461 char *buf ATTRIBUTE_UNUSED
,
462 size_t bufsiz ATTRIBUTE_UNUSED
)
464 #if defined (_WIN32) \
465 || defined(__vxworks) || defined (__PikeOS__)
468 return readlink (path
, buf
, bufsiz
);
472 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
473 If NEWPATH exists it will NOT be overwritten.
474 For systems not supporting symbolic links, always return -1. */
477 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED
,
478 char *newpath ATTRIBUTE_UNUSED
)
480 #if defined (_WIN32) \
481 || defined(__vxworks) || defined (__PikeOS__)
484 return symlink (oldpath
, newpath
);
488 /* Try to lock a file, return 1 if success. */
490 #if defined (__vxworks) \
491 || defined (_WIN32) || defined (__PikeOS__)
493 /* Version that does not use link. */
496 __gnat_try_lock (char *dir
, char *file
)
500 TCHAR wfull_path
[GNAT_MAX_PATH_LEN
];
501 TCHAR wfile
[GNAT_MAX_PATH_LEN
];
502 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
504 S2WSC (wdir
, dir
, GNAT_MAX_PATH_LEN
);
505 S2WSC (wfile
, file
, GNAT_MAX_PATH_LEN
);
507 /* ??? the code below crash on MingW64 for obscure reasons, a ticket
508 has been opened here:
510 https://sourceforge.net/p/mingw-w64/bugs/414/
512 As a workaround an equivalent set of code has been put in place below.
514 _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
517 _tcscpy (wfull_path
, wdir
);
518 _tcscat (wfull_path
, L
"\\");
519 _tcscat (wfull_path
, wfile
);
521 fd
= _topen (wfull_path
, O_CREAT
| O_EXCL
, 0600);
525 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
526 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
538 /* Version using link(), more secure over NFS. */
539 /* See TN 6913-016 for discussion ??? */
542 __gnat_try_lock (char *dir
, char *file
)
546 GNAT_STRUCT_STAT stat_result
;
549 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
550 sprintf (temp_file
, "%s%cTMP-%ld-%ld",
551 dir
, DIR_SEPARATOR
, (long)getpid(), (long)getppid ());
553 /* Create the temporary file and write the process number. */
554 fd
= open (temp_file
, O_CREAT
| O_WRONLY
, 0600);
560 /* Link it with the new file. */
561 link (temp_file
, full_path
);
563 /* Count the references on the old one. If we have a count of two, then
564 the link did succeed. Remove the temporary file before returning. */
565 __gnat_stat (temp_file
, &stat_result
);
567 return stat_result
.st_nlink
== 2;
571 /* Return the maximum file name length. */
574 __gnat_get_maximum_file_name_length (void)
579 /* Return nonzero if file names are case sensitive. */
581 static int file_names_case_sensitive_cache
= -1;
584 __gnat_get_file_names_case_sensitive (void)
586 if (file_names_case_sensitive_cache
== -1)
588 const char *sensitive
= getenv ("GNAT_FILE_NAME_CASE_SENSITIVE");
590 if (sensitive
!= NULL
591 && (sensitive
[0] == '0' || sensitive
[0] == '1')
592 && sensitive
[1] == '\0')
593 file_names_case_sensitive_cache
= sensitive
[0] - '0';
596 /* By default, we suppose filesystems aren't case sensitive on
597 Windows and Darwin (but they are on arm-darwin). */
598 #if defined (WINNT) || defined (__DJGPP__) \
599 || (defined (__APPLE__) && !(defined (__arm__) || defined (__arm64__)))
600 file_names_case_sensitive_cache
= 0;
602 file_names_case_sensitive_cache
= 1;
606 return file_names_case_sensitive_cache
;
609 /* Return nonzero if environment variables are case sensitive. */
612 __gnat_get_env_vars_case_sensitive (void)
614 #if defined (WINNT) || defined (__DJGPP__)
622 __gnat_get_default_identifier_character_set (void)
627 /* Return the current working directory. */
630 __gnat_get_current_dir (char *dir
, int *length
)
632 #if defined (__MINGW32__)
633 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
635 _tgetcwd (wdir
, *length
);
637 WS2SC (dir
, wdir
, GNAT_MAX_PATH_LEN
);
640 char* result
= getcwd (dir
, *length
);
641 /* If the current directory does not exist, set length = 0
642 to indicate error. That can't happen on windows, where
643 you can't delete a directory if it is the current
644 directory of some process. */
652 *length
= strlen (dir
);
654 if (dir
[*length
- 1] != DIR_SEPARATOR
)
656 dir
[*length
] = DIR_SEPARATOR
;
662 /* Return the suffix for object files. */
665 __gnat_get_object_suffix_ptr (int *len
, const char **value
)
667 *value
= HOST_OBJECT_SUFFIX
;
672 *len
= strlen (*value
);
677 /* Return the suffix for executable files. */
680 __gnat_get_executable_suffix_ptr (int *len
, const char **value
)
682 *value
= HOST_EXECUTABLE_SUFFIX
;
687 *len
= strlen (*value
);
692 /* Return the suffix for debuggable files. Usually this is the same as the
693 executable extension. */
696 __gnat_get_debuggable_suffix_ptr (int *len
, const char **value
)
698 *value
= HOST_EXECUTABLE_SUFFIX
;
703 *len
= strlen (*value
);
708 /* Returns the OS filename and corresponding encoding. */
711 __gnat_os_filename (char *filename ATTRIBUTE_UNUSED
,
712 char *w_filename ATTRIBUTE_UNUSED
,
713 char *os_name
, int *o_length
,
714 char *encoding ATTRIBUTE_UNUSED
, int *e_length
)
716 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
717 WS2SC (os_name
, (TCHAR
*)w_filename
, (DWORD
)*o_length
);
718 *o_length
= strlen (os_name
);
719 strcpy (encoding
, "encoding=utf8");
720 *e_length
= strlen (encoding
);
722 strcpy (os_name
, filename
);
723 *o_length
= strlen (filename
);
731 __gnat_unlink (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 _tunlink (wpath
);
741 return unlink (path
);
748 __gnat_rename (char *from
, char *to
)
750 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
752 TCHAR wfrom
[GNAT_MAX_PATH_LEN
], wto
[GNAT_MAX_PATH_LEN
];
754 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
);
755 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
);
756 return _trename (wfrom
, wto
);
759 return rename (from
, to
);
763 /* Changing directory. */
766 __gnat_chdir (char *path
)
768 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
770 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
772 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
773 return _tchdir (wpath
);
780 /* Removing a directory. */
783 __gnat_rmdir (char *path
)
785 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
787 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
789 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
790 return _trmdir (wpath
);
792 #elif defined (VTHREADS)
793 /* rmdir not available */
800 #if defined (_WIN32) || defined (__linux__) || defined (__sun__) \
801 || defined (__FreeBSD__) || defined(__DragonFly__) || defined (__QNX__)
802 #define HAS_TARGET_WCHAR_T
805 #ifdef HAS_TARGET_WCHAR_T
810 __gnat_fputwc(int c
, FILE *stream
)
812 #ifdef HAS_TARGET_WCHAR_T
813 return fputwc ((wchar_t)c
, stream
);
815 return fputc (c
, stream
);
820 __gnat_fopen (char *path
, char *mode
, int encoding ATTRIBUTE_UNUSED
)
822 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
823 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
826 S2WS (wmode
, mode
, 10);
828 if (encoding
== Encoding_Unspecified
)
829 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
830 else if (encoding
== Encoding_UTF8
)
831 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
833 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
835 return _tfopen (wpath
, wmode
);
838 return GNAT_FOPEN (path
, mode
);
843 __gnat_freopen (char *path
,
846 int encoding ATTRIBUTE_UNUSED
)
848 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
849 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
852 S2WS (wmode
, mode
, 10);
854 if (encoding
== Encoding_Unspecified
)
855 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
856 else if (encoding
== Encoding_UTF8
)
857 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
859 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
861 return _tfreopen (wpath
, wmode
, stream
);
863 return freopen (path
, mode
, stream
);
868 __gnat_open_read (char *path
, int fmode
)
871 int o_fmode
= O_BINARY
;
876 #if defined (__vxworks)
877 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
878 #elif defined (__MINGW32__)
880 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
882 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
883 fd
= _topen (wpath
, O_RDONLY
| o_fmode
, 0444);
886 fd
= GNAT_OPEN (path
, O_RDONLY
| o_fmode
);
889 return fd
< 0 ? -1 : fd
;
892 #if defined (__MINGW32__)
893 #define PERM (S_IREAD | S_IWRITE)
895 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
899 __gnat_open_rw (char *path
, int fmode
)
902 int o_fmode
= O_BINARY
;
907 #if defined (__MINGW32__)
909 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
911 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
912 fd
= _topen (wpath
, O_RDWR
| o_fmode
, PERM
);
915 fd
= GNAT_OPEN (path
, O_RDWR
| o_fmode
, PERM
);
918 return fd
< 0 ? -1 : fd
;
922 __gnat_open_create (char *path
, int fmode
)
925 int o_fmode
= O_BINARY
;
930 #if defined (__MINGW32__)
932 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
934 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
935 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
938 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
941 return fd
< 0 ? -1 : fd
;
945 __gnat_create_output_file (char *path
)
948 #if defined (__MINGW32__)
950 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
952 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
953 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
956 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
959 return fd
< 0 ? -1 : fd
;
963 __gnat_create_output_file_new (char *path
)
966 #if defined (__MINGW32__)
968 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
970 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
971 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
974 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
977 return fd
< 0 ? -1 : fd
;
981 __gnat_open_append (char *path
, int fmode
)
984 int o_fmode
= O_BINARY
;
989 #if defined (__MINGW32__)
991 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
993 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
994 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
997 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
1000 return fd
< 0 ? -1 : fd
;
1003 /* Open a new file. Return error (-1) if the file already exists. */
1006 __gnat_open_new (char *path
, int fmode
)
1009 int o_fmode
= O_BINARY
;
1014 #if defined (__MINGW32__)
1016 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1018 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1019 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1022 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1025 return fd
< 0 ? -1 : fd
;
1028 /* Open a new temp file. Return error (-1) if the file already exists. */
1031 __gnat_open_new_temp (char *path
, int fmode
)
1034 int o_fmode
= O_BINARY
;
1036 strcpy (path
, "GNAT-XXXXXX");
1038 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
1039 || defined (__linux__) || defined (__GLIBC__) || defined (__ANDROID__) \
1040 || defined (__DragonFly__) || defined (__QNX__)) && !defined (__vxworks)
1041 return mkstemp (path
);
1042 #elif defined (__Lynx__)
1045 if (mktemp (path
) == NULL
)
1052 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1053 return fd
< 0 ? -1 : fd
;
1057 __gnat_open (char *path
, int fmode
)
1061 #if defined (__MINGW32__)
1063 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1065 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1066 fd
= _topen (wpath
, fmode
, PERM
);
1069 fd
= GNAT_OPEN (path
, fmode
, PERM
);
1072 return fd
< 0 ? -1 : fd
;
1075 /****************************************************************
1076 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
1077 ** as possible from it, storing the result in a cache for later reuse
1078 ****************************************************************/
1081 __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
)
1083 GNAT_STRUCT_STAT statbuf
;
1087 /* GNAT_FSTAT returns -1 and sets errno for failure */
1088 ret
= GNAT_FSTAT (fd
, &statbuf
);
1089 error
= ret
? errno
: 0;
1092 /* __gnat_stat returns errno value directly */
1093 error
= __gnat_stat (name
, &statbuf
);
1094 ret
= error
? -1 : 0;
1098 * A missing file is reported as an attr structure with error == 0 and
1102 if (error
== 0 || error
== ENOENT
)
1105 attr
->error
= error
;
1107 attr
->regular
= (!ret
&& S_ISREG (statbuf
.st_mode
));
1108 attr
->directory
= (!ret
&& S_ISDIR (statbuf
.st_mode
));
1111 attr
->file_length
= 0;
1113 /* st_size may be 32 bits, or 64 bits which is converted to long. We
1114 don't return a useful value for files larger than 2 gigabytes in
1116 attr
->file_length
= statbuf
.st_size
; /* all systems */
1118 attr
->exists
= !ret
;
1120 #if !defined (_WIN32)
1121 /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
1122 attr
->readable
= (!ret
&& (statbuf
.st_mode
& S_IRUSR
));
1123 attr
->writable
= (!ret
&& (statbuf
.st_mode
& S_IWUSR
));
1124 attr
->executable
= (!ret
&& (statbuf
.st_mode
& S_IXUSR
));
1128 attr
->timestamp
= (OS_Time
)-1;
1130 attr
->timestamp
= (OS_Time
)statbuf
.st_mtime
;
1134 /****************************************************************
1135 ** Return the number of bytes in the specified file
1136 ****************************************************************/
1139 __gnat_file_length_attr (int fd
, char* name
, struct file_attributes
* attr
)
1141 if (attr
->file_length
== -1) {
1142 __gnat_stat_to_attr (fd
, name
, attr
);
1145 return attr
->file_length
;
1149 __gnat_file_length (int fd
)
1151 struct file_attributes attr
;
1152 __gnat_reset_attributes (&attr
);
1153 return __gnat_file_length_attr (fd
, NULL
, &attr
);
1157 __gnat_file_length_long (int fd
)
1159 struct file_attributes attr
;
1160 __gnat_reset_attributes (&attr
);
1161 return (long)__gnat_file_length_attr (fd
, NULL
, &attr
);
1165 __gnat_named_file_length (char *name
)
1167 struct file_attributes attr
;
1168 __gnat_reset_attributes (&attr
);
1169 return __gnat_file_length_attr (-1, name
, &attr
);
1172 /* Create a temporary filename and put it in string pointed to by
1176 __gnat_tmp_name (char *tmp_filename
)
1178 #if defined (__MINGW32__)
1183 /* tempnam tries to create a temporary file in directory pointed to by
1184 TMP environment variable, in c:\temp if TMP is not set, and in
1185 directory specified by P_tmpdir in stdio.h if c:\temp does not
1186 exist. The filename will be created with the prefix "gnat-". */
1188 sprintf (prefix
, "gnat-%d-", (int)getpid());
1189 pname
= (char *) _tempnam ("c:\\temp", prefix
);
1191 /* if pname is NULL, the file was not created properly, the disk is full
1192 or there is no more free temporary files */
1195 *tmp_filename
= '\0';
1197 /* If pname start with a back slash and not path information it means that
1198 the filename is valid for the current working directory. */
1200 else if (pname
[0] == '\\')
1202 strcpy (tmp_filename
, ".\\");
1203 strcat (tmp_filename
, pname
+1);
1206 strcpy (tmp_filename
, pname
);
1211 #elif defined (__linux__) || defined (__FreeBSD__) || defined (__NetBSD__) \
1212 || defined (__OpenBSD__) || defined (__GLIBC__) || defined (__ANDROID__) \
1213 || defined (__DragonFly__) || defined (__QNX__)
1214 #define MAX_SAFE_PATH 1000
1215 char *tmpdir
= getenv ("TMPDIR");
1217 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1218 a buffer overflow. */
1219 if (tmpdir
== NULL
|| strlen (tmpdir
) > MAX_SAFE_PATH
)
1221 strcpy (tmp_filename
, "/cache/gnat-XXXXXX");
1223 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
1226 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
1228 close (mkstemp(tmp_filename
));
1229 #elif defined (__vxworks) && !defined (VTHREADS)
1233 static ushort_t seed
= 0; /* used to generate unique name */
1235 /* Generate a unique name. */
1236 strcpy (tmp_filename
, "tmp");
1239 savepos
= pos
= tmp_filename
+ strlen (tmp_filename
) + index
;
1247 /* Fill up the name buffer from the last position. */
1249 for (t
= seed
; --index
>= 0; t
>>= 3)
1250 *--pos
= '0' + (t
& 07);
1252 /* Check to see if its unique, if not bump the seed and try again. */
1253 f
= fopen (tmp_filename
, "r");
1261 tmpnam (tmp_filename
);
1265 /* Open directory and returns a DIR pointer. */
1267 DIR* __gnat_opendir (char *name
)
1269 #if defined (__MINGW32__)
1270 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1272 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1273 return (DIR*)_topendir (wname
);
1276 return opendir (name
);
1280 /* Read the next entry in a directory. The returned string points somewhere
1283 #if defined (__sun__)
1284 /* For Solaris, be sure to use the 64-bit version, otherwise NFS reads may
1285 fail with EOVERFLOW if the server uses 64-bit cookies. */
1286 #define dirent dirent64
1287 #define readdir readdir64
1291 __gnat_readdir (DIR *dirp
, char *buffer
, int *len
)
1293 #if defined (__MINGW32__)
1294 struct _tdirent
*dirent
= _treaddir ((_TDIR
*)dirp
);
1298 WS2SC (buffer
, dirent
->d_name
, GNAT_MAX_PATH_LEN
);
1299 *len
= strlen (buffer
);
1306 #elif defined (HAVE_READDIR_R)
1307 /* If possible, try to use the thread-safe version. */
1308 if (readdir_r (dirp
, buffer
) != NULL
)
1310 *len
= strlen (((struct dirent
*) buffer
)->d_name
);
1311 return ((struct dirent
*) buffer
)->d_name
;
1317 struct dirent
*dirent
= (struct dirent
*) readdir (dirp
);
1321 strcpy (buffer
, dirent
->d_name
);
1322 *len
= strlen (buffer
);
1331 /* Close a directory entry. */
1333 int __gnat_closedir (DIR *dirp
)
1335 #if defined (__MINGW32__)
1336 return _tclosedir ((_TDIR
*)dirp
);
1339 return closedir (dirp
);
1343 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1346 __gnat_readdir_is_thread_safe (void)
1348 #ifdef HAVE_READDIR_R
1355 #if defined (_WIN32)
1356 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1357 static const unsigned long long w32_epoch_offset
= 11644473600ULL;
1359 /* Returns the file modification timestamp using Win32 routines which are
1360 immune against daylight saving time change. It is in fact not possible to
1361 use fstat for this purpose as the DST modify the st_mtime field of the
1365 win32_filetime (HANDLE h
)
1370 unsigned long long ull_time
;
1373 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1374 since <Jan 1st 1601>. This function must return the number of seconds
1375 since <Jan 1st 1970>. */
1377 if (GetFileTime (h
, NULL
, NULL
, &t_write
.ft_time
))
1378 return (time_t) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1382 /* As above but starting from a FILETIME. */
1384 f2t (const FILETIME
*ft
, __time64_t
*t
)
1389 unsigned long long ull_time
;
1392 t_write
.ft_time
= *ft
;
1393 *t
= (__time64_t
) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1397 /* Return a GNAT time stamp given a file name. */
1400 __gnat_file_time_name_attr (char* name
, struct file_attributes
* attr
)
1402 if (attr
->timestamp
== (OS_Time
)-2) {
1403 #if defined (_WIN32)
1405 WIN32_FILE_ATTRIBUTE_DATA fad
;
1406 __time64_t ret
= -1;
1407 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1408 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1410 if ((res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
)))
1411 f2t (&fad
.ftLastWriteTime
, &ret
);
1412 attr
->timestamp
= (OS_Time
) ret
;
1414 __gnat_stat_to_attr (-1, name
, attr
);
1417 return attr
->timestamp
;
1421 __gnat_file_time_name (char *name
)
1423 struct file_attributes attr
;
1424 __gnat_reset_attributes (&attr
);
1425 return __gnat_file_time_name_attr (name
, &attr
);
1428 /* Return a GNAT time stamp given a file descriptor. */
1431 __gnat_file_time_fd_attr (int fd
, struct file_attributes
* attr
)
1433 if (attr
->timestamp
== (OS_Time
)-2) {
1434 #if defined (_WIN32)
1435 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
1436 time_t ret
= win32_filetime (h
);
1437 attr
->timestamp
= (OS_Time
) ret
;
1440 __gnat_stat_to_attr (fd
, NULL
, attr
);
1444 return attr
->timestamp
;
1448 __gnat_file_time_fd (int fd
)
1450 struct file_attributes attr
;
1451 __gnat_reset_attributes (&attr
);
1452 return __gnat_file_time_fd_attr (fd
, &attr
);
1455 /* Set the file time stamp. */
1458 __gnat_set_file_time_name (char *name
, time_t time_stamp
)
1460 #if defined (__vxworks)
1462 /* Code to implement __gnat_set_file_time_name for these systems. */
1464 #elif defined (_WIN32)
1468 unsigned long long ull_time
;
1470 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1472 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1474 HANDLE h
= CreateFile
1475 (wname
, GENERIC_WRITE
, FILE_SHARE_WRITE
, NULL
,
1476 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
,
1478 if (h
== INVALID_HANDLE_VALUE
)
1480 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1481 t_write
.ull_time
= ((unsigned long long)time_stamp
+ w32_epoch_offset
);
1482 /* Convert to 100 nanosecond units */
1483 t_write
.ull_time
*= 10000000ULL;
1485 SetFileTime(h
, NULL
, NULL
, &t_write
.ft_time
);
1490 struct utimbuf utimbuf
;
1493 /* Set modification time to requested time. */
1494 utimbuf
.modtime
= time_stamp
;
1496 /* Set access time to now in local time. */
1498 utimbuf
.actime
= mktime (localtime (&t
));
1500 utime (name
, &utimbuf
);
1504 /* Get the list of installed standard libraries from the
1505 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1509 __gnat_get_libraries_from_registry (void)
1511 char *result
= (char *) xmalloc (1);
1515 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
1518 DWORD name_size
, value_size
;
1525 /* First open the key. */
1526 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1528 if (res
== ERROR_SUCCESS
)
1529 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1530 KEY_READ
, ®_key
);
1532 if (res
== ERROR_SUCCESS
)
1533 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1535 if (res
== ERROR_SUCCESS
)
1536 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1538 /* If the key exists, read out all the values in it and concatenate them
1540 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1542 value_size
= name_size
= 256;
1543 res
= RegEnumValueA (reg_key
, index
, name
, &name_size
, 0,
1544 &type
, (LPBYTE
)value
, &value_size
);
1546 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1548 char *old_result
= result
;
1550 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1551 strcpy (result
, old_result
);
1552 strcat (result
, value
);
1553 strcat (result
, ";");
1558 /* Remove the trailing ";". */
1560 result
[strlen (result
) - 1] = 0;
1566 /* Query information for the given file NAME and return it in STATBUF.
1567 * Returns 0 for success, or errno value for failure.
1570 __gnat_stat (char *name
, GNAT_STRUCT_STAT
*statbuf
)
1573 WIN32_FILE_ATTRIBUTE_DATA fad
;
1574 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1579 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1580 name_len
= _tcslen (wname
);
1582 if (name_len
> GNAT_MAX_PATH_LEN
)
1585 ZeroMemory (statbuf
, sizeof(GNAT_STRUCT_STAT
));
1587 res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
);
1590 error
= GetLastError();
1592 /* Check file existence using GetFileAttributes() which does not fail on
1593 special Windows files like con:, aux:, nul: etc... */
1595 if (GetFileAttributes(wname
) != INVALID_FILE_ATTRIBUTES
) {
1596 /* Just pretend that it is a regular and readable file */
1597 statbuf
->st_mode
= S_IFREG
| S_IREAD
| S_IWRITE
;
1602 case ERROR_ACCESS_DENIED
:
1603 case ERROR_SHARING_VIOLATION
:
1604 case ERROR_LOCK_VIOLATION
:
1605 case ERROR_SHARING_BUFFER_EXCEEDED
:
1607 case ERROR_BUFFER_OVERFLOW
:
1608 return ENAMETOOLONG
;
1609 case ERROR_NOT_ENOUGH_MEMORY
:
1616 f2t (&fad
.ftCreationTime
, &statbuf
->st_ctime
);
1617 f2t (&fad
.ftLastWriteTime
, &statbuf
->st_mtime
);
1618 f2t (&fad
.ftLastAccessTime
, &statbuf
->st_atime
);
1621 (__int64
)fad
.nFileSizeLow
| (__int64
)fad
.nFileSizeHigh
<< 32;
1623 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1624 statbuf
->st_mode
= S_IREAD
;
1626 if (fad
.dwFileAttributes
& FILE_ATTRIBUTE_DIRECTORY
)
1627 statbuf
->st_mode
|= S_IFDIR
;
1629 statbuf
->st_mode
|= S_IFREG
;
1631 if (!(fad
.dwFileAttributes
& FILE_ATTRIBUTE_READONLY
))
1632 statbuf
->st_mode
|= S_IWRITE
;
1637 return GNAT_STAT (name
, statbuf
) == 0 ? 0 : errno
;
1641 /*************************************************************************
1642 ** Check whether a file exists
1643 *************************************************************************/
1646 __gnat_file_exists_attr (char* name
, struct file_attributes
* attr
)
1648 if (attr
->exists
== ATTR_UNSET
)
1649 __gnat_stat_to_attr (-1, name
, attr
);
1651 return attr
->exists
;
1655 __gnat_file_exists (char *name
)
1657 struct file_attributes attr
;
1658 __gnat_reset_attributes (&attr
);
1659 return __gnat_file_exists_attr (name
, &attr
);
1662 /**********************************************************************
1663 ** Whether name is an absolute path
1664 **********************************************************************/
1667 __gnat_is_absolute_path (char *name
, int length
)
1670 /* On VxWorks systems, an absolute path can be represented (depending on
1671 the host platform) as either /dir/file, or device:/dir/file, or
1672 device:drive_letter:/dir/file. */
1679 for (index
= 0; index
< length
; index
++)
1681 if (name
[index
] == ':' &&
1682 ((name
[index
+ 1] == '/') ||
1683 (isalpha (name
[index
+ 1]) && index
+ 2 <= length
&&
1684 name
[index
+ 2] == '/')))
1687 else if (name
[index
] == '/')
1692 return (length
!= 0) &&
1693 (*name
== '/' || *name
== DIR_SEPARATOR
1694 #if defined (WINNT) || defined(__DJGPP__)
1695 || (length
> 1 && ISALPHA (name
[0]) && name
[1] == ':')
1702 __gnat_is_regular_file_attr (char* name
, struct file_attributes
* attr
)
1704 if (attr
->regular
== ATTR_UNSET
)
1705 __gnat_stat_to_attr (-1, name
, attr
);
1707 return attr
->regular
;
1711 __gnat_is_regular_file (char *name
)
1713 struct file_attributes attr
;
1715 __gnat_reset_attributes (&attr
);
1716 return __gnat_is_regular_file_attr (name
, &attr
);
1720 __gnat_is_regular_file_fd (int fd
)
1723 GNAT_STRUCT_STAT statbuf
;
1725 ret
= GNAT_FSTAT (fd
, &statbuf
);
1726 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1730 __gnat_is_directory_attr (char* name
, struct file_attributes
* attr
)
1732 if (attr
->directory
== ATTR_UNSET
)
1733 __gnat_stat_to_attr (-1, name
, attr
);
1735 return attr
->directory
;
1739 __gnat_is_directory (char *name
)
1741 struct file_attributes attr
;
1743 __gnat_reset_attributes (&attr
);
1744 return __gnat_is_directory_attr (name
, &attr
);
1747 #if defined (_WIN32)
1749 /* Returns the same constant as GetDriveType but takes a pathname as
1753 GetDriveTypeFromPath (TCHAR
*wfullpath
)
1755 TCHAR wdrv
[MAX_PATH
];
1756 TCHAR wpath
[MAX_PATH
];
1757 TCHAR wfilename
[MAX_PATH
];
1758 TCHAR wext
[MAX_PATH
];
1760 _tsplitpath (wfullpath
, wdrv
, wpath
, wfilename
, wext
);
1762 if (_tcslen (wdrv
) != 0)
1764 /* we have a drive specified. */
1765 _tcscat (wdrv
, _T("\\"));
1766 return GetDriveType (wdrv
);
1770 /* No drive specified. */
1772 /* Is this a relative path, if so get current drive type. */
1773 if (wpath
[0] != _T('\\') ||
1774 (_tcslen (wpath
) > 2 && wpath
[0] == _T('\\')
1775 && wpath
[1] != _T('\\')))
1776 return GetDriveType (NULL
);
1778 UINT result
= GetDriveType (wpath
);
1780 /* Cannot guess the drive type, is this \\.\ ? */
1782 if (result
== DRIVE_NO_ROOT_DIR
&&
1783 _tcslen (wpath
) >= 4 && wpath
[0] == _T('\\') && wpath
[1] == _T('\\')
1784 && wpath
[2] == _T('.') && wpath
[3] == _T('\\'))
1786 if (_tcslen (wpath
) == 4)
1787 _tcscat (wpath
, wfilename
);
1789 LPTSTR p
= &wpath
[4];
1790 LPTSTR b
= _tcschr (p
, _T('\\'));
1794 /* logical drive \\.\c\dir\file */
1800 _tcscat (p
, _T(":\\"));
1802 return GetDriveType (p
);
1809 /* This MingW section contains code to work with ACL. */
1811 __gnat_check_OWNER_ACL (TCHAR
*wname
,
1812 DWORD CheckAccessDesired
,
1813 GENERIC_MAPPING CheckGenericMapping
)
1815 DWORD dwAccessDesired
, dwAccessAllowed
;
1816 PRIVILEGE_SET PrivilegeSet
;
1817 DWORD dwPrivSetSize
= sizeof (PRIVILEGE_SET
);
1818 BOOL fAccessGranted
= FALSE
;
1819 HANDLE hToken
= NULL
;
1821 PSECURITY_DESCRIPTOR pSD
= NULL
;
1824 (wname
, OWNER_SECURITY_INFORMATION
|
1825 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1828 if ((pSD
= (SECURITY_DESCRIPTOR
*) HeapAlloc
1829 (GetProcessHeap (), HEAP_ZERO_MEMORY
, nLength
)) == NULL
)
1832 /* Obtain the security descriptor. */
1834 if (!GetFileSecurity
1835 (wname
, OWNER_SECURITY_INFORMATION
|
1836 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1837 pSD
, nLength
, &nLength
))
1840 if (!ImpersonateSelf (SecurityImpersonation
))
1843 if (!OpenThreadToken
1844 (GetCurrentThread(), TOKEN_DUPLICATE
| TOKEN_QUERY
, FALSE
, &hToken
))
1847 /* Undoes the effect of ImpersonateSelf. */
1851 /* We want to test for write permissions. */
1853 dwAccessDesired
= CheckAccessDesired
;
1855 MapGenericMask (&dwAccessDesired
, &CheckGenericMapping
);
1858 (pSD
, /* security descriptor to check */
1859 hToken
, /* impersonation token */
1860 dwAccessDesired
, /* requested access rights */
1861 &CheckGenericMapping
, /* pointer to GENERIC_MAPPING */
1862 &PrivilegeSet
, /* receives privileges used in check */
1863 &dwPrivSetSize
, /* size of PrivilegeSet buffer */
1864 &dwAccessAllowed
, /* receives mask of allowed access rights */
1868 CloseHandle (hToken
);
1869 HeapFree (GetProcessHeap (), 0, pSD
);
1870 return fAccessGranted
;
1874 CloseHandle (hToken
);
1875 HeapFree (GetProcessHeap (), 0, pSD
);
1880 __gnat_set_OWNER_ACL (TCHAR
*wname
,
1881 ACCESS_MODE AccessMode
,
1882 DWORD AccessPermissions
)
1884 PACL pOldDACL
= NULL
;
1885 PACL pNewDACL
= NULL
;
1886 PSECURITY_DESCRIPTOR pSD
= NULL
;
1888 TCHAR username
[100];
1891 /* Get current user, he will act as the owner */
1893 if (!GetUserName (username
, &unsize
))
1896 if (GetNamedSecurityInfo
1899 DACL_SECURITY_INFORMATION
,
1900 NULL
, NULL
, &pOldDACL
, NULL
, &pSD
) != ERROR_SUCCESS
)
1903 BuildExplicitAccessWithName
1904 (&ea
, username
, AccessPermissions
, (ACCESS_MODE
) AccessMode
, NO_INHERITANCE
);
1906 if (AccessMode
== SET_ACCESS
)
1908 /* SET_ACCESS, we want to set an explicte set of permissions, do not
1909 merge with current DACL. */
1910 if (SetEntriesInAcl (1, &ea
, NULL
, &pNewDACL
) != ERROR_SUCCESS
)
1914 if (SetEntriesInAcl (1, &ea
, pOldDACL
, &pNewDACL
) != ERROR_SUCCESS
)
1917 if (SetNamedSecurityInfo
1918 (wname
, SE_FILE_OBJECT
,
1919 DACL_SECURITY_INFORMATION
, NULL
, NULL
, pNewDACL
, NULL
) != ERROR_SUCCESS
)
1923 LocalFree (pNewDACL
);
1926 /* Check if it is possible to use ACL for wname, the file must not be on a
1930 __gnat_can_use_acl (TCHAR
*wname
)
1932 return __gnat_use_acl
&& GetDriveTypeFromPath (wname
) != DRIVE_REMOTE
;
1935 #endif /* defined (_WIN32) */
1938 __gnat_is_readable_file_attr (char* name
, struct file_attributes
* attr
)
1940 if (attr
->readable
== ATTR_UNSET
)
1942 #if defined (_WIN32)
1943 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1944 GENERIC_MAPPING GenericMapping
;
1946 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1948 if (__gnat_can_use_acl (wname
))
1950 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1951 GenericMapping
.GenericRead
= GENERIC_READ
;
1953 __gnat_check_OWNER_ACL (wname
, FILE_READ_DATA
, GenericMapping
);
1956 attr
->readable
= GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
;
1958 __gnat_stat_to_attr (-1, name
, attr
);
1962 return attr
->readable
;
1966 __gnat_is_read_accessible_file (char *name
)
1968 #if defined (_WIN32)
1969 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1971 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1973 return !_waccess (wname
, 4);
1975 #elif defined (__vxworks)
1978 if ((fd
= open (name
, O_RDONLY
, 0)) < 0)
1984 return !access (name
, R_OK
);
1989 __gnat_is_readable_file (char *name
)
1991 struct file_attributes attr
;
1993 __gnat_reset_attributes (&attr
);
1994 return __gnat_is_readable_file_attr (name
, &attr
);
1998 __gnat_is_writable_file_attr (char* name
, struct file_attributes
* attr
)
2000 if (attr
->writable
== ATTR_UNSET
)
2002 #if defined (_WIN32)
2003 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2004 GENERIC_MAPPING GenericMapping
;
2006 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2008 if (__gnat_can_use_acl (wname
))
2010 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2011 GenericMapping
.GenericWrite
= GENERIC_WRITE
;
2013 attr
->writable
= __gnat_check_OWNER_ACL
2014 (wname
, FILE_WRITE_DATA
| FILE_APPEND_DATA
, GenericMapping
)
2015 && !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
2019 !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
2022 __gnat_stat_to_attr (-1, name
, attr
);
2026 return attr
->writable
;
2030 __gnat_is_writable_file (char *name
)
2032 struct file_attributes attr
;
2034 __gnat_reset_attributes (&attr
);
2035 return __gnat_is_writable_file_attr (name
, &attr
);
2039 __gnat_is_write_accessible_file (char *name
)
2041 #if defined (_WIN32)
2042 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2044 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2046 return !_waccess (wname
, 2);
2048 #elif defined (__vxworks)
2051 if ((fd
= open (name
, O_WRONLY
, 0)) < 0)
2057 return !access (name
, W_OK
);
2062 __gnat_is_executable_file_attr (char* name
, struct file_attributes
* attr
)
2064 if (attr
->executable
== ATTR_UNSET
)
2066 #if defined (_WIN32)
2067 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2068 GENERIC_MAPPING GenericMapping
;
2070 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2072 if (__gnat_can_use_acl (wname
))
2074 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2075 GenericMapping
.GenericExecute
= GENERIC_EXECUTE
;
2078 __gnat_check_OWNER_ACL (wname
, FILE_EXECUTE
, GenericMapping
);
2082 TCHAR
*l
, *last
= _tcsstr(wname
, _T(".exe"));
2084 /* look for last .exe */
2086 while ((l
= _tcsstr(last
+1, _T(".exe"))))
2090 GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
2091 && (last
- wname
) == (int) (_tcslen (wname
) - 4);
2094 __gnat_stat_to_attr (-1, name
, attr
);
2098 return attr
->regular
&& attr
->executable
;
2102 __gnat_is_executable_file (char *name
)
2104 struct file_attributes attr
;
2106 __gnat_reset_attributes (&attr
);
2107 return __gnat_is_executable_file_attr (name
, &attr
);
2111 __gnat_set_writable (char *name
)
2113 #if defined (_WIN32)
2114 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2116 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2118 if (__gnat_can_use_acl (wname
))
2119 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_WRITE
);
2122 (wname
, GetFileAttributes (wname
) & ~FILE_ATTRIBUTE_READONLY
);
2123 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2124 GNAT_STRUCT_STAT statbuf
;
2126 if (GNAT_STAT (name
, &statbuf
) == 0)
2128 statbuf
.st_mode
= statbuf
.st_mode
| S_IWUSR
;
2129 chmod (name
, statbuf
.st_mode
);
2134 /* must match definition in s-os_lib.ads */
2140 __gnat_set_executable (char *name
, int mode ATTRIBUTE_UNUSED
)
2142 #if defined (_WIN32)
2143 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2145 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2147 if (__gnat_can_use_acl (wname
))
2148 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_EXECUTE
);
2150 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2151 GNAT_STRUCT_STAT statbuf
;
2153 if (GNAT_STAT (name
, &statbuf
) == 0)
2156 statbuf
.st_mode
= statbuf
.st_mode
| S_IXUSR
;
2158 statbuf
.st_mode
= statbuf
.st_mode
| S_IXGRP
;
2159 if (mode
& S_OTHERS
)
2160 statbuf
.st_mode
= statbuf
.st_mode
| S_IXOTH
;
2161 chmod (name
, statbuf
.st_mode
);
2167 __gnat_set_non_writable (char *name
)
2169 #if defined (_WIN32)
2170 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2172 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2174 if (__gnat_can_use_acl (wname
))
2175 __gnat_set_OWNER_ACL
2176 (wname
, DENY_ACCESS
,
2177 FILE_WRITE_DATA
| FILE_APPEND_DATA
|
2178 FILE_WRITE_EA
| FILE_WRITE_ATTRIBUTES
);
2181 (wname
, GetFileAttributes (wname
) | FILE_ATTRIBUTE_READONLY
);
2182 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2183 GNAT_STRUCT_STAT statbuf
;
2185 if (GNAT_STAT (name
, &statbuf
) == 0)
2187 statbuf
.st_mode
= statbuf
.st_mode
& 07577;
2188 chmod (name
, statbuf
.st_mode
);
2194 __gnat_set_readable (char *name
)
2196 #if defined (_WIN32)
2197 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2199 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2201 if (__gnat_can_use_acl (wname
))
2202 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_READ
);
2204 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2205 GNAT_STRUCT_STAT statbuf
;
2207 if (GNAT_STAT (name
, &statbuf
) == 0)
2209 chmod (name
, statbuf
.st_mode
| S_IREAD
);
2215 __gnat_set_non_readable (char *name
)
2217 #if defined (_WIN32)
2218 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2220 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2222 if (__gnat_can_use_acl (wname
))
2223 __gnat_set_OWNER_ACL (wname
, DENY_ACCESS
, FILE_GENERIC_READ
);
2225 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2226 GNAT_STRUCT_STAT statbuf
;
2228 if (GNAT_STAT (name
, &statbuf
) == 0)
2230 chmod (name
, statbuf
.st_mode
& (~S_IREAD
));
2236 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED
,
2237 struct file_attributes
* attr
)
2239 if (attr
->symbolic_link
== ATTR_UNSET
)
2241 #if defined (__vxworks)
2242 attr
->symbolic_link
= 0;
2244 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2246 GNAT_STRUCT_STAT statbuf
;
2247 ret
= GNAT_LSTAT (name
, &statbuf
);
2248 attr
->symbolic_link
= (!ret
&& S_ISLNK (statbuf
.st_mode
));
2250 attr
->symbolic_link
= 0;
2253 return attr
->symbolic_link
;
2257 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED
)
2259 struct file_attributes attr
;
2261 __gnat_reset_attributes (&attr
);
2262 return __gnat_is_symbolic_link_attr (name
, &attr
);
2265 #if defined (__sun__)
2266 /* Using fork on Solaris will duplicate all the threads. fork1, which
2267 duplicates only the active thread, must be used instead, or spawning
2268 subprocess from a program with tasking will lead into numerous problems. */
2273 __gnat_portable_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2275 int status ATTRIBUTE_UNUSED
= 0;
2276 int finished ATTRIBUTE_UNUSED
;
2277 int pid ATTRIBUTE_UNUSED
;
2279 #if defined (__vxworks) || defined(__PikeOS__)
2282 #elif defined (__DJGPP__) || defined (_WIN32)
2283 /* args[0] must be quotes as it could contain a full pathname with spaces */
2284 char *args_0
= args
[0];
2285 args
[0] = (char *)xmalloc (strlen (args_0
) + 3);
2286 strcpy (args
[0], "\"");
2287 strcat (args
[0], args_0
);
2288 strcat (args
[0], "\"");
2290 status
= spawnvp (P_WAIT
, args_0
, (char ** const)args
);
2292 /* restore previous value */
2294 args
[0] = (char *)args_0
;
2310 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2315 finished
= waitpid (pid
, &status
, 0);
2317 if (finished
!= pid
|| WIFEXITED (status
) == 0)
2320 return WEXITSTATUS (status
);
2326 /* Create a copy of the given file descriptor.
2327 Return -1 if an error occurred. */
2330 __gnat_dup (int oldfd
)
2332 #if defined (__vxworks) && !defined (__RTP__)
2333 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2341 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2342 Return -1 if an error occurred. */
2345 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED
, int newfd ATTRIBUTE_UNUSED
)
2347 #if defined (__vxworks) && !defined (__RTP__)
2348 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2351 #elif defined (__PikeOS__)
2352 /* Not supported. */
2354 #elif defined (_WIN32)
2355 /* Special case when oldfd and newfd are identical and are the standard
2356 input, output or error as this makes Windows XP hangs. Note that we
2357 do that only for standard file descriptors that are known to be valid. */
2358 if (oldfd
== newfd
&& newfd
>= 0 && newfd
<= 2)
2361 return dup2 (oldfd
, newfd
);
2363 return dup2 (oldfd
, newfd
);
2368 __gnat_number_of_cpus (void)
2372 #if defined (__linux__) || defined (__sun__) || defined (_AIX) \
2373 || defined (__APPLE__) || defined (__FreeBSD__) || defined (__OpenBSD__) \
2374 || defined (__DragonFly__) || defined (__NetBSD__)
2375 cores
= (int) sysconf (_SC_NPROCESSORS_ONLN
);
2377 #elif defined (__QNX__)
2378 cores
= (int) _syspage_ptr
->num_cpu
;
2380 #elif defined (__hpux__)
2381 struct pst_dynamic psd
;
2382 if (pstat_getdynamic (&psd
, sizeof (psd
), 1, 0) != -1)
2383 cores
= (int) psd
.psd_proc_cnt
;
2385 #elif defined (_WIN32)
2386 SYSTEM_INFO sysinfo
;
2387 GetSystemInfo (&sysinfo
);
2388 cores
= (int) sysinfo
.dwNumberOfProcessors
;
2390 #elif defined (_WRS_CONFIG_SMP)
2391 unsigned int vxCpuConfiguredGet (void);
2393 cores
= vxCpuConfiguredGet ();
2400 /* WIN32 code to implement a wait call that wait for any child process. */
2402 #if defined (_WIN32)
2404 /* Synchronization code, to be thread safe. */
2408 /* For the Cert run times on native Windows we use dummy functions
2409 for locking and unlocking tasks since we do not support multiple
2410 threads on this configuration (Cert run time on native Windows). */
2412 static void EnterCS (void) {}
2413 static void LeaveCS (void) {}
2414 static void SignalListChanged (void) {}
2418 CRITICAL_SECTION ProcListCS
;
2419 HANDLE ProcListEvt
= NULL
;
2421 static void EnterCS (void)
2423 EnterCriticalSection(&ProcListCS
);
2426 static void LeaveCS (void)
2428 LeaveCriticalSection(&ProcListCS
);
2431 static void SignalListChanged (void)
2433 SetEvent (ProcListEvt
);
2438 static HANDLE
*HANDLES_LIST
= NULL
;
2439 static int *PID_LIST
= NULL
, plist_length
= 0, plist_max_length
= 0;
2442 add_handle (HANDLE h
, int pid
)
2444 /* -------------------- critical section -------------------- */
2447 if (plist_length
== plist_max_length
)
2449 plist_max_length
+= 100;
2451 (HANDLE
*) xrealloc (HANDLES_LIST
, sizeof (HANDLE
) * plist_max_length
);
2453 (int *) xrealloc (PID_LIST
, sizeof (int) * plist_max_length
);
2456 HANDLES_LIST
[plist_length
] = h
;
2457 PID_LIST
[plist_length
] = pid
;
2460 SignalListChanged();
2462 /* -------------------- critical section -------------------- */
2466 __gnat_win32_remove_handle (HANDLE h
, int pid
)
2471 /* -------------------- critical section -------------------- */
2474 for (j
= 0; j
< plist_length
; j
++)
2476 if ((HANDLES_LIST
[j
] == h
) || (PID_LIST
[j
] == pid
))
2480 HANDLES_LIST
[j
] = HANDLES_LIST
[plist_length
];
2481 PID_LIST
[j
] = PID_LIST
[plist_length
];
2488 /* -------------------- critical section -------------------- */
2491 SignalListChanged();
2497 win32_no_block_spawn (char *command
, char *args
[], HANDLE
*h
, int *pid
)
2501 PROCESS_INFORMATION PI
;
2502 SECURITY_ATTRIBUTES SA
;
2507 /* compute the total command line length */
2511 csize
+= strlen (args
[k
]) + 1;
2515 full_command
= (char *) xmalloc (csize
);
2518 SI
.cb
= sizeof (STARTUPINFO
);
2519 SI
.lpReserved
= NULL
;
2520 SI
.lpReserved2
= NULL
;
2521 SI
.lpDesktop
= NULL
;
2525 SI
.wShowWindow
= SW_HIDE
;
2527 /* Security attributes. */
2528 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
2529 SA
.bInheritHandle
= TRUE
;
2530 SA
.lpSecurityDescriptor
= NULL
;
2532 /* Prepare the command string. */
2533 strcpy (full_command
, command
);
2534 strcat (full_command
, " ");
2539 strcat (full_command
, args
[k
]);
2540 strcat (full_command
, " ");
2545 int wsize
= csize
* 2;
2546 TCHAR
*wcommand
= (TCHAR
*) xmalloc (wsize
);
2548 S2WSC (wcommand
, full_command
, wsize
);
2550 free (full_command
);
2552 result
= CreateProcess
2553 (NULL
, wcommand
, &SA
, NULL
, TRUE
,
2554 GetPriorityClass (GetCurrentProcess()), NULL
, NULL
, &SI
, &PI
);
2561 CloseHandle (PI
.hThread
);
2563 *pid
= PI
.dwProcessId
;
2573 win32_wait (int *status
)
2575 DWORD exitcode
, pid
;
2586 if (plist_length
== 0)
2592 /* -------------------- critical section -------------------- */
2595 /* ??? We can't wait for more than MAXIMUM_WAIT_OBJECTS due to a Win32
2597 if (plist_length
< MAXIMUM_WAIT_OBJECTS
)
2598 hl_len
= plist_length
;
2606 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
);
2607 memmove (hl
, HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2608 pidl
= (int *) xmalloc (sizeof (int) * hl_len
);
2609 memmove (pidl
, PID_LIST
, sizeof (int) * hl_len
);
2611 /* Note that index 0 contains the event handle that is signaled when the
2612 process list has changed */
2613 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * (hl_len
+ 1));
2614 hl
[0] = ProcListEvt
;
2615 memmove (&hl
[1], HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2616 pidl
= (int *) xmalloc (sizeof (int) * (hl_len
+ 1));
2617 memmove (&pidl
[1], PID_LIST
, sizeof (int) * hl_len
);
2622 /* -------------------- critical section -------------------- */
2624 res
= WaitForMultipleObjects (hl_len
, hl
, FALSE
, INFINITE
);
2626 /* If there was an error, exit now */
2627 if (res
== WAIT_FAILED
)
2635 /* if the ProcListEvt has been signaled then the list of processes has been
2636 updated to add or remove a handle, just loop over */
2638 if (res
- WAIT_OBJECT_0
== 0)
2645 /* Handle two distinct groups of return codes: finished waits and abandoned
2648 if (res
< WAIT_ABANDONED_0
)
2649 pos
= res
- WAIT_OBJECT_0
;
2651 pos
= res
- WAIT_ABANDONED_0
;
2654 GetExitCodeProcess (h
, &exitcode
);
2657 found
= __gnat_win32_remove_handle (h
, -1);
2662 /* if not found another process waiting has already handled this process */
2669 *status
= (int) exitcode
;
2676 __gnat_portable_no_block_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2679 #if defined (__vxworks) || defined (__PikeOS__)
2680 /* Not supported. */
2683 #elif defined(__DJGPP__)
2684 if (spawnvp (P_WAIT
, args
[0], args
) != 0)
2689 #elif defined (_WIN32)
2694 win32_no_block_spawn (args
[0], args
, &h
, &pid
);
2697 add_handle (h
, pid
);
2710 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2720 __gnat_portable_wait (int *process_status
)
2725 #if defined (__vxworks) || defined (__PikeOS__)
2726 /* Not sure what to do here, so do nothing but return zero. */
2728 #elif defined (_WIN32)
2730 pid
= win32_wait (&status
);
2732 #elif defined (__DJGPP__)
2733 /* Child process has already ended in case of DJGPP.
2734 No need to do anything. Just return success. */
2737 pid
= waitpid (-1, &status
, 0);
2738 status
= status
& 0xffff;
2741 *process_status
= status
;
2746 __gnat_portable_no_block_wait (int *process_status
)
2751 #if defined (__vxworks) || defined (__PikeOS__) || defined (_WIN32)
2752 /* Not supported. */
2757 pid
= waitpid (-1, &status
, WNOHANG
);
2758 status
= status
& 0xffff;
2761 *process_status
= status
;
2766 __gnat_os_exit (int status
)
2772 __gnat_current_process_id (void)
2774 #if defined (__vxworks) || defined (__PikeOS__)
2777 #elif defined (_WIN32)
2779 return (int)GetCurrentProcessId();
2783 return (int)getpid();
2787 /* Locate file on path, that matches a predicate */
2790 __gnat_locate_file_with_predicate (char *file_name
, char *path_val
,
2791 int (*predicate
)(char *))
2794 char *file_path
= (char *) alloca (strlen (file_name
) + 1);
2797 /* Return immediately if file_name is empty */
2799 if (*file_name
== '\0')
2802 /* Remove quotes around file_name if present */
2808 strcpy (file_path
, ptr
);
2810 ptr
= file_path
+ strlen (file_path
) - 1;
2815 /* Handle absolute pathnames. */
2817 absolute
= __gnat_is_absolute_path (file_path
, strlen (file_name
));
2821 if (predicate (file_path
))
2822 return xstrdup (file_path
);
2827 /* If file_name include directory separator(s), try it first as
2828 a path name relative to the current directory */
2829 for (ptr
= file_name
; *ptr
&& *ptr
!= '/' && *ptr
!= DIR_SEPARATOR
; ptr
++)
2834 if (predicate (file_name
))
2835 return xstrdup (file_name
);
2842 /* The result has to be smaller than path_val + file_name. */
2844 (char *) alloca (strlen (path_val
) + strlen (file_name
) + 2);
2848 /* Skip the starting quote */
2850 if (*path_val
== '"')
2853 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
2854 *ptr
++ = *path_val
++;
2856 /* If directory is empty, it is the current directory*/
2858 if (ptr
== file_path
)
2865 /* Skip the ending quote */
2870 if (*ptr
!= '/' && *ptr
!= DIR_SEPARATOR
)
2871 *++ptr
= DIR_SEPARATOR
;
2873 strcpy (++ptr
, file_name
);
2875 if (predicate (file_path
))
2876 return xstrdup (file_path
);
2881 /* Skip path separator */
2890 /* Locate an executable file, give a Path value. */
2893 __gnat_locate_executable_file (char *file_name
, char *path_val
)
2895 return __gnat_locate_file_with_predicate
2896 (file_name
, path_val
, &__gnat_is_executable_file
);
2899 /* Locate a regular file, give a Path value. */
2902 __gnat_locate_regular_file (char *file_name
, char *path_val
)
2904 return __gnat_locate_file_with_predicate
2905 (file_name
, path_val
, &__gnat_is_regular_file
);
2908 /* Locate an executable given a Path argument. This routine is only used by
2909 gnatbl and should not be used otherwise. Use locate_exec_on_path
2913 __gnat_locate_exec (char *exec_name
, char *path_val
)
2915 const unsigned int len
= strlen (HOST_EXECUTABLE_SUFFIX
);
2918 if (len
> 0 && !strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
2920 char *full_exec_name
= (char *) alloca (strlen (exec_name
) + len
+ 1);
2922 strcpy (full_exec_name
, exec_name
);
2923 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
2924 ptr
= __gnat_locate_executable_file (full_exec_name
, path_val
);
2927 return __gnat_locate_executable_file (exec_name
, path_val
);
2931 return __gnat_locate_executable_file (exec_name
, path_val
);
2934 /* Locate an executable using the Systems default PATH. */
2937 __gnat_locate_exec_on_path (char *exec_name
)
2941 #if defined (_WIN32)
2942 TCHAR
*wpath_val
= _tgetenv (_T("PATH"));
2944 /* In Win32 systems we expand the PATH as for XP environment
2945 variables are not automatically expanded. We also prepend the
2946 ".;" to the path to match normal NT path search semantics */
2948 #define EXPAND_BUFFER_SIZE 32767
2950 wapath_val
= (TCHAR
*) alloca (EXPAND_BUFFER_SIZE
);
2952 wapath_val
[0] = '.';
2953 wapath_val
[1] = ';';
2955 DWORD res
= ExpandEnvironmentStrings
2956 (wpath_val
, &wapath_val
[2], EXPAND_BUFFER_SIZE
- 2);
2958 if (!res
) wapath_val
[0] = _T('\0');
2960 apath_val
= (char *) alloca (EXPAND_BUFFER_SIZE
);
2962 WS2SC (apath_val
, wapath_val
, EXPAND_BUFFER_SIZE
);
2965 const char *path_val
= getenv ("PATH");
2967 /* If PATH is not defined, proceed with __gnat_locate_exec anyway, so we can
2968 find files that contain directory names. */
2970 if (path_val
== NULL
) path_val
= "";
2971 apath_val
= (char *) alloca (strlen (path_val
) + 1);
2972 strcpy (apath_val
, path_val
);
2975 return __gnat_locate_exec (exec_name
, apath_val
);
2978 /* Dummy functions for Osint import for non-VMS systems.
2979 ??? To be removed. */
2982 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED
,
2983 int onlydirs ATTRIBUTE_UNUSED
)
2989 __gnat_to_canonical_file_list_next (void)
2991 static char empty
[] = "";
2996 __gnat_to_canonical_file_list_free (void)
3001 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
3007 __gnat_to_canonical_file_spec (char *filespec
)
3013 __gnat_to_canonical_path_spec (char *pathspec
)
3019 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
3025 __gnat_to_host_file_spec (char *filespec
)
3031 __gnat_adjust_os_resource_limits (void)
3035 #if defined (__mips_vxworks)
3039 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
3043 #if defined (_WIN32)
3044 int __gnat_argument_needs_quote
= 1;
3046 int __gnat_argument_needs_quote
= 0;
3049 /* This option is used to enable/disable object files handling from the
3050 binder file by the GNAT Project module. For example, this is disabled on
3051 Windows (prior to GCC 3.4) as it is already done by the mdll module.
3052 Stating with GCC 3.4 the shared libraries are not based on mdll
3053 anymore as it uses the GCC's -shared option */
3054 #if defined (_WIN32) \
3055 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
3056 int __gnat_prj_add_obj_files
= 0;
3058 int __gnat_prj_add_obj_files
= 1;
3061 /* char used as prefix/suffix for environment variables */
3062 #if defined (_WIN32)
3063 char __gnat_environment_char
= '%';
3065 char __gnat_environment_char
= '$';
3068 /* This functions copy the file attributes from a source file to a
3071 mode = 0 : In this mode copy only the file time stamps (last access and
3072 last modification time stamps).
3074 mode = 1 : In this mode, time stamps and read/write/execute attributes are
3077 mode = 2 : In this mode, only read/write/execute attributes are copied
3079 Returns 0 if operation was successful and -1 in case of error. */
3082 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED
, char *to ATTRIBUTE_UNUSED
,
3083 int mode ATTRIBUTE_UNUSED
)
3085 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
3088 #elif defined (_WIN32)
3089 TCHAR wfrom
[GNAT_MAX_PATH_LEN
+ 2];
3090 TCHAR wto
[GNAT_MAX_PATH_LEN
+ 2];
3092 FILETIME fct
, flat
, flwt
;
3095 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
+ 2);
3096 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
+ 2);
3098 /* Do we need to copy the timestamp ? */
3101 /* retrieve from times */
3104 (wfrom
, GENERIC_READ
, 0, NULL
, OPEN_EXISTING
,
3105 FILE_ATTRIBUTE_NORMAL
, NULL
);
3107 if (hfrom
== INVALID_HANDLE_VALUE
)
3110 res
= GetFileTime (hfrom
, &fct
, &flat
, &flwt
);
3112 CloseHandle (hfrom
);
3117 /* retrieve from times */
3120 (wto
, GENERIC_WRITE
, 0, NULL
, OPEN_EXISTING
,
3121 FILE_ATTRIBUTE_NORMAL
, NULL
);
3123 if (hto
== INVALID_HANDLE_VALUE
)
3126 res
= SetFileTime (hto
, NULL
, &flat
, &flwt
);
3134 /* Do we need to copy the permissions ? */
3135 /* Set file attributes in full mode. */
3139 DWORD attribs
= GetFileAttributes (wfrom
);
3141 if (attribs
== INVALID_FILE_ATTRIBUTES
)
3144 res
= SetFileAttributes (wto
, attribs
);
3152 GNAT_STRUCT_STAT fbuf
;
3153 struct utimbuf tbuf
;
3155 if (GNAT_STAT (from
, &fbuf
) == -1) {
3159 /* Do we need to copy timestamp ? */
3161 tbuf
.actime
= fbuf
.st_atime
;
3162 tbuf
.modtime
= fbuf
.st_mtime
;
3164 if (utime (to
, &tbuf
) == -1) {
3169 /* Do we need to copy file permissions ? */
3170 if (mode
!= 0 && (chmod (to
, fbuf
.st_mode
) == -1)) {
3179 __gnat_lseek (int fd
, long offset
, int whence
)
3181 return (int) lseek (fd
, offset
, whence
);
3184 /* This function returns the major version number of GCC being used. */
3186 get_gcc_version (void)
3191 return (int) (version_string
[0] - '0');
3196 * Set Close_On_Exec as indicated.
3197 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
3201 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED
,
3202 int close_on_exec_p ATTRIBUTE_UNUSED
)
3204 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3205 int flags
= fcntl (fd
, F_GETFD
, 0);
3208 if (close_on_exec_p
)
3209 flags
|= FD_CLOEXEC
;
3211 flags
&= ~FD_CLOEXEC
;
3212 return fcntl (fd
, F_SETFD
, flags
);
3213 #elif defined(_WIN32)
3214 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
3215 if (h
== (HANDLE
) -1)
3217 if (close_on_exec_p
)
3218 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
, 0);
3219 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
,
3220 HANDLE_FLAG_INHERIT
);
3222 /* TODO: Unimplemented. */
3227 /* Indicates if platforms supports automatic initialization through the
3228 constructor mechanism */
3230 __gnat_binder_supports_auto_init (void)
3235 /* Indicates that Stand-Alone Libraries are automatically initialized through
3236 the constructor mechanism */
3238 __gnat_sals_init_using_constructors (void)
3240 #if defined (__vxworks) || defined (__Lynx__)
3247 #if defined (__linux__) || defined (__ANDROID__)
3248 /* There is no function in the glibc to retrieve the LWP of the current
3249 thread. We need to do a system call in order to retrieve this
3251 #include <sys/syscall.h>
3253 __gnat_lwp_self (void)
3255 return (void *) syscall (__NR_gettid
);
3259 #if defined (__APPLE__)
3260 # if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1060
3261 # include <mach/thread_info.h>
3262 # include <mach/mach_init.h>
3263 # include <mach/thread_act.h>
3265 # include <pthread.h>
3268 /* System-wide thread identifier. Note it could be truncated on 32 bit
3270 Previously was: pthread_mach_thread_np (pthread_self ()). */
3272 __gnat_lwp_self (void)
3274 #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1060
3275 thread_identifier_info_data_t data
;
3276 mach_msg_type_number_t count
= THREAD_IDENTIFIER_INFO_COUNT
;
3279 kret
= thread_info (mach_thread_self (), THREAD_IDENTIFIER_INFO
,
3280 (thread_info_t
) &data
, &count
);
3281 if (kret
== KERN_SUCCESS
)
3282 return (void *)(uintptr_t)data
.thread_id
;
3286 return (void *)pthread_mach_thread_np (pthread_self ());
3291 #if defined (__linux__)
3294 /* glibc versions earlier than 2.7 do not define the routines to handle
3295 dynamically allocated CPU sets. For these targets, we use the static
3300 /* Dynamic cpu sets */
3303 __gnat_cpu_alloc (size_t count
)
3305 return CPU_ALLOC (count
);
3309 __gnat_cpu_alloc_size (size_t count
)
3311 return CPU_ALLOC_SIZE (count
);
3315 __gnat_cpu_free (cpu_set_t
*set
)
3321 __gnat_cpu_zero (size_t count
, cpu_set_t
*set
)
3323 CPU_ZERO_S (count
, set
);
3327 __gnat_cpu_set (int cpu
, size_t count
, cpu_set_t
*set
)
3329 /* Ada handles CPU numbers starting from 1, while C identifies the first
3330 CPU by a 0, so we need to adjust. */
3331 CPU_SET_S (cpu
- 1, count
, set
);
3334 #else /* !CPU_ALLOC */
3336 /* Static cpu sets */
3339 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED
)
3341 return (cpu_set_t
*) xmalloc (sizeof (cpu_set_t
));
3345 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED
)
3347 return sizeof (cpu_set_t
);
3351 __gnat_cpu_free (cpu_set_t
*set
)
3357 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3363 __gnat_cpu_set (int cpu
, size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3365 /* Ada handles CPU numbers starting from 1, while C identifies the first
3366 CPU by a 0, so we need to adjust. */
3367 CPU_SET (cpu
- 1, set
);
3369 #endif /* !CPU_ALLOC */
3370 #endif /* __linux__ */
3372 /* Return the load address of the executable, or 0 if not known. In the
3373 specific case of error, (void *)-1 can be returned. Beware: this unit may
3374 be in a shared library. As low-level units are needed, we allow #include
3377 #if defined (__APPLE__)
3378 #include <mach-o/dyld.h>
3382 __gnat_get_executable_load_address (void)
3384 #if defined (__APPLE__)
3385 return _dyld_get_image_header (0);
3387 #elif 0 && defined (__linux__)
3388 /* Currently disabled as it needs at least -ldl. */
3389 struct link_map
*map
= _r_debug
.r_map
;
3391 return (const void *)map
->l_addr
;
3399 __gnat_kill (int pid
, int sig
, int close ATTRIBUTE_UNUSED
)
3402 HANDLE h
= OpenProcess (PROCESS_ALL_ACCESS
, FALSE
, pid
);
3407 TerminateProcess (h
, 1);
3409 else if (sig
== SIGINT
)
3410 GenerateConsoleCtrlEvent (CTRL_C_EVENT
, pid
);
3411 else if (sig
== SIGBREAK
)
3412 GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT
, pid
);
3413 /* ??? The last two alternatives don't really work. SIGBREAK requires setting
3414 up process groups at start time which we don't do; treating SIGINT is just
3415 not possible apparently. So we really only support signal 9. Fortunately
3416 that's all we use in GNAT.Expect */
3419 #elif defined (__vxworks)
3420 /* Not implemented */
3426 void __gnat_killprocesstree (int pid
, int sig_num
)
3431 memset(&pe
, 0, sizeof(PROCESSENTRY32
));
3432 pe
.dwSize
= sizeof(PROCESSENTRY32
);
3434 HANDLE hSnap
= CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS
, 0);
3436 /* cannot take snapshot, just kill the parent process */
3438 if (hSnap
== INVALID_HANDLE_VALUE
)
3440 __gnat_kill (pid
, sig_num
, 1);
3444 if (Process32First(hSnap
, &pe
))
3446 BOOL bContinue
= TRUE
;
3448 /* kill child processes first */
3452 if (pe
.th32ParentProcessID
== (DWORD
)pid
)
3453 __gnat_killprocesstree (pe
.th32ProcessID
, sig_num
);
3455 bContinue
= Process32Next (hSnap
, &pe
);
3459 CloseHandle (hSnap
);
3463 __gnat_kill (pid
, sig_num
, 1);
3465 #elif defined (__vxworks)
3466 /* not implemented */
3468 #elif defined (__linux__)
3472 /* read all processes' pid and ppid */
3474 dir
= opendir ("/proc");
3476 /* cannot open proc, just kill the parent process */
3480 __gnat_kill (pid
, sig_num
, 1);
3484 /* kill child processes first */
3486 while ((d
= readdir (dir
)) != NULL
)
3488 if ((d
->d_type
& DT_DIR
) == DT_DIR
)
3493 /* read /proc/<PID>/stat */
3495 if (strlen (d
->d_name
) >= sizeof (statfile
) - strlen ("/proc//stat"))
3497 strcpy (statfile
, "/proc/");
3498 strcat (statfile
, d
->d_name
);
3499 strcat (statfile
, "/stat");
3501 FILE *fd
= fopen (statfile
, "r");
3505 const int match
= fscanf (fd
, "%d %*s %*s %d", &_pid
, &_ppid
);
3508 if (match
== 2 && _ppid
== pid
)
3509 __gnat_killprocesstree (_pid
, sig_num
);
3518 __gnat_kill (pid
, sig_num
, 1);
3520 __gnat_kill (pid
, sig_num
, 1);
3522 /* Note on Solaris it is possible to read /proc/<PID>/status.
3523 The 5th and 6th words are the pid and the 7th and 8th the ppid.
3524 See: /usr/include/sys/procfs.h (struct pstatus).