1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2018, 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>
97 #if defined (__vxworks) || defined (__ANDROID__)
98 /* S_IREAD and S_IWRITE are not defined in VxWorks or Android */
100 #define S_IREAD (S_IRUSR | S_IRGRP | S_IROTH)
104 #define S_IWRITE (S_IWUSR)
108 /* We don't have libiberty, so use malloc. */
109 #define xmalloc(S) malloc (S)
110 #define xrealloc(V,S) realloc (V,S)
121 #if defined (__DJGPP__)
123 /* For isalpha-like tests in the compiler, we're expected to resort to
124 safe-ctype.h/ISALPHA. This isn't available for the runtime library
125 build, so we fallback on ctype.h/isalpha there. */
129 #define ISALPHA isalpha
132 #elif defined (__MINGW32__) || defined (__CYGWIN__)
136 /* Current code page and CCS encoding to use, set in initialize.c. */
137 UINT __gnat_current_codepage
;
138 UINT __gnat_current_ccs_encoding
;
140 #include <sys/utime.h>
142 /* For isalpha-like tests in the compiler, we're expected to resort to
143 safe-ctype.h/ISALPHA. This isn't available for the runtime library
144 build, so we fallback on ctype.h/isalpha there. */
148 #define ISALPHA isalpha
151 #elif defined (__Lynx__)
153 /* Lynx utime.h only defines the entities of interest to us if
154 defined (VMOS_DEV), so ... */
163 /* wait.h processing */
166 # include <sys/wait.h>
168 #elif defined (__vxworks) && defined (__RTP__)
170 #elif defined (__Lynx__)
171 /* ??? We really need wait.h and it includes resource.h on Lynx. GCC
172 has a resource.h header as well, included instead of the lynx
173 version in our setup, causing lots of errors. We don't really need
174 the lynx contents of this file, so just workaround the issue by
175 preventing the inclusion of the GCC header from doing anything. */
176 # define GCC_RESOURCE_H
177 # include <sys/wait.h>
178 #elif defined (__PikeOS__)
179 /* No wait() or waitpid() calls available. */
182 #include <sys/wait.h>
185 #if defined (__DJGPP__)
191 #define DIR_SEPARATOR '\\'
193 #elif defined (_WIN32)
198 #include <tlhelp32.h>
201 #define DIR_SEPARATOR '\\'
209 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
210 defined in the current system. On DOS-like systems these flags control
211 whether the file is opened/created in text-translation mode (CR/LF in
212 external file mapped to LF in internal file), but in Unix-like systems,
213 no text translation is required, so these flags have no effect. */
223 #ifndef HOST_EXECUTABLE_SUFFIX
224 #define HOST_EXECUTABLE_SUFFIX ""
227 #ifndef HOST_OBJECT_SUFFIX
228 #define HOST_OBJECT_SUFFIX ".o"
231 #ifndef PATH_SEPARATOR
232 #define PATH_SEPARATOR ':'
235 #ifndef DIR_SEPARATOR
236 #define DIR_SEPARATOR '/'
239 /* Check for cross-compilation. */
240 #if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
242 int __gnat_is_cross_compiler
= 1;
245 int __gnat_is_cross_compiler
= 0;
248 char __gnat_dir_separator
= DIR_SEPARATOR
;
250 char __gnat_path_separator
= PATH_SEPARATOR
;
252 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
253 the base filenames that libraries specified with -lsomelib options
254 may have. This is used by GNATMAKE to check whether an executable
255 is up-to-date or not. The syntax is
257 library_template ::= { pattern ; } pattern NUL
258 pattern ::= [ prefix ] * [ postfix ]
260 These should only specify names of static libraries as it makes
261 no sense to determine at link time if dynamic-link libraries are
262 up to date or not. Any libraries that are not found are supposed
265 * if they are needed but not present, the link
268 * otherwise they are libraries in the system paths and so
269 they are considered part of the system and not checked
272 ??? This should be part of a GNAT host-specific compiler
273 file instead of being included in all user applications
274 as well. This is only a temporary work-around for 3.11b. */
276 #ifndef GNAT_LIBRARY_TEMPLATE
277 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
280 const char *__gnat_library_template
= GNAT_LIBRARY_TEMPLATE
;
282 #if defined (__vxworks)
283 #define GNAT_MAX_PATH_LEN PATH_MAX
287 #if defined (__MINGW32__)
291 #include <sys/param.h>
295 #include <sys/param.h>
299 #define GNAT_MAX_PATH_LEN MAXPATHLEN
301 #define GNAT_MAX_PATH_LEN 256
306 /* Used for runtime check that Ada constant File_Attributes_Size is no
307 less than the actual size of struct file_attributes (see Osint
309 int __gnat_size_of_file_attributes
= sizeof (struct file_attributes
);
311 void __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
);
313 /* The __gnat_max_path_len variable is used to export the maximum
314 length of a path name to Ada code. max_path_len is also provided
315 for compatibility with older GNAT versions, please do not use
318 int __gnat_max_path_len
= GNAT_MAX_PATH_LEN
;
319 int max_path_len
= GNAT_MAX_PATH_LEN
;
321 /* Control whether we can use ACL on Windows. */
323 int __gnat_use_acl
= 1;
325 /* The following macro HAVE_READDIR_R should be defined if the
326 system provides the routine readdir_r.
327 ... but we never define it anywhere??? */
328 #undef HAVE_READDIR_R
330 #define MAYBE_TO_PTR32(argv) argv
332 static const char ATTR_UNSET
= 127;
334 /* Reset the file attributes as if no system call had been performed */
337 __gnat_reset_attributes (struct file_attributes
* attr
)
339 attr
->exists
= ATTR_UNSET
;
340 attr
->error
= EINVAL
;
342 attr
->writable
= ATTR_UNSET
;
343 attr
->readable
= ATTR_UNSET
;
344 attr
->executable
= ATTR_UNSET
;
346 attr
->regular
= ATTR_UNSET
;
347 attr
->symbolic_link
= ATTR_UNSET
;
348 attr
->directory
= ATTR_UNSET
;
350 attr
->timestamp
= (OS_Time
)-2;
351 attr
->file_length
= -1;
355 __gnat_error_attributes (struct file_attributes
*attr
) {
360 __gnat_current_time (void)
362 time_t res
= time (NULL
);
363 return (OS_Time
) res
;
366 /* Return the current local time as a string in the ISO 8601 format of
367 "YYYY-MM-DD HH:MM:SS.SS". The returned string is 22 + 1 (NULL) characters
371 __gnat_current_time_string (char *result
)
373 const char *format
= "%Y-%m-%d %H:%M:%S";
374 /* Format string necessary to describe the ISO 8601 format */
376 const time_t t_val
= time (NULL
);
378 strftime (result
, 22, format
, localtime (&t_val
));
379 /* Convert the local time into a string following the ISO format, copying
380 at most 22 characters into the result string. */
385 /* The sub-seconds are manually set to zero since type time_t lacks the
386 precision necessary for nanoseconds. */
390 __gnat_to_gm_time (OS_Time
*p_time
, int *p_year
, int *p_month
, int *p_day
,
391 int *p_hours
, int *p_mins
, int *p_secs
)
394 time_t time
= (time_t) *p_time
;
397 /* On Windows systems, the time is sometimes rounded up to the nearest
398 even second, so if the number of seconds is odd, increment it. */
403 res
= gmtime (&time
);
406 *p_year
= res
->tm_year
;
407 *p_month
= res
->tm_mon
;
408 *p_day
= res
->tm_mday
;
409 *p_hours
= res
->tm_hour
;
410 *p_mins
= res
->tm_min
;
411 *p_secs
= res
->tm_sec
;
414 *p_year
= *p_month
= *p_day
= *p_hours
= *p_mins
= *p_secs
= 0;
418 __gnat_to_os_time (OS_Time
*p_time
, int year
, int month
, int day
,
419 int hours
, int mins
, int secs
)
431 /* returns -1 of failing, this is s-os_lib Invalid_Time */
433 *p_time
= (OS_Time
) mktime (&v
);
436 /* Place the contents of the symbolic link named PATH in the buffer BUF,
437 which has size BUFSIZ. If PATH is a symbolic link, then return the number
438 of characters of its content in BUF. Otherwise, return -1.
439 For systems not supporting symbolic links, always return -1. */
442 __gnat_readlink (char *path ATTRIBUTE_UNUSED
,
443 char *buf ATTRIBUTE_UNUSED
,
444 size_t bufsiz ATTRIBUTE_UNUSED
)
446 #if defined (_WIN32) \
447 || defined(__vxworks) || defined (__PikeOS__)
450 return readlink (path
, buf
, bufsiz
);
454 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
455 If NEWPATH exists it will NOT be overwritten.
456 For systems not supporting symbolic links, always return -1. */
459 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED
,
460 char *newpath ATTRIBUTE_UNUSED
)
462 #if defined (_WIN32) \
463 || defined(__vxworks) || defined (__PikeOS__)
466 return symlink (oldpath
, newpath
);
470 /* Try to lock a file, return 1 if success. */
472 #if defined (__vxworks) \
473 || defined (_WIN32) || defined (__PikeOS__)
475 /* Version that does not use link. */
478 __gnat_try_lock (char *dir
, char *file
)
482 TCHAR wfull_path
[GNAT_MAX_PATH_LEN
];
483 TCHAR wfile
[GNAT_MAX_PATH_LEN
];
484 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
486 S2WSC (wdir
, dir
, GNAT_MAX_PATH_LEN
);
487 S2WSC (wfile
, file
, GNAT_MAX_PATH_LEN
);
489 /* ??? the code below crash on MingW64 for obscure reasons, a ticket
490 has been opened here:
492 https://sourceforge.net/p/mingw-w64/bugs/414/
494 As a workaround an equivalent set of code has been put in place below.
496 _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
499 _tcscpy (wfull_path
, wdir
);
500 _tcscat (wfull_path
, L
"\\");
501 _tcscat (wfull_path
, wfile
);
503 fd
= _topen (wfull_path
, O_CREAT
| O_EXCL
, 0600);
507 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
508 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
520 /* Version using link(), more secure over NFS. */
521 /* See TN 6913-016 for discussion ??? */
524 __gnat_try_lock (char *dir
, char *file
)
528 GNAT_STRUCT_STAT stat_result
;
531 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
532 sprintf (temp_file
, "%s%cTMP-%ld-%ld",
533 dir
, DIR_SEPARATOR
, (long)getpid(), (long)getppid ());
535 /* Create the temporary file and write the process number. */
536 fd
= open (temp_file
, O_CREAT
| O_WRONLY
, 0600);
542 /* Link it with the new file. */
543 link (temp_file
, full_path
);
545 /* Count the references on the old one. If we have a count of two, then
546 the link did succeed. Remove the temporary file before returning. */
547 __gnat_stat (temp_file
, &stat_result
);
549 return stat_result
.st_nlink
== 2;
553 /* Return the maximum file name length. */
556 __gnat_get_maximum_file_name_length (void)
561 /* Return nonzero if file names are case sensitive. */
563 static int file_names_case_sensitive_cache
= -1;
566 __gnat_get_file_names_case_sensitive (void)
568 if (file_names_case_sensitive_cache
== -1)
570 const char *sensitive
= getenv ("GNAT_FILE_NAME_CASE_SENSITIVE");
572 if (sensitive
!= NULL
573 && (sensitive
[0] == '0' || sensitive
[0] == '1')
574 && sensitive
[1] == '\0')
575 file_names_case_sensitive_cache
= sensitive
[0] - '0';
578 /* By default, we suppose filesystems aren't case sensitive on
579 Windows and Darwin (but they are on arm-darwin). */
580 #if defined (WINNT) || defined (__DJGPP__) \
581 || (defined (__APPLE__) && !(defined (__arm__) || defined (__arm64__)))
582 file_names_case_sensitive_cache
= 0;
584 file_names_case_sensitive_cache
= 1;
588 return file_names_case_sensitive_cache
;
591 /* Return nonzero if environment variables are case sensitive. */
594 __gnat_get_env_vars_case_sensitive (void)
596 #if defined (WINNT) || defined (__DJGPP__)
604 __gnat_get_default_identifier_character_set (void)
609 /* Return the current working directory. */
612 __gnat_get_current_dir (char *dir
, int *length
)
614 #if defined (__MINGW32__)
615 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
617 _tgetcwd (wdir
, *length
);
619 WS2SC (dir
, wdir
, GNAT_MAX_PATH_LEN
);
622 char* result
= getcwd (dir
, *length
);
623 /* If the current directory does not exist, set length = 0
624 to indicate error. That can't happen on windows, where
625 you can't delete a directory if it is the current
626 directory of some process. */
634 *length
= strlen (dir
);
636 if (dir
[*length
- 1] != DIR_SEPARATOR
)
638 dir
[*length
] = DIR_SEPARATOR
;
644 /* Return the suffix for object files. */
647 __gnat_get_object_suffix_ptr (int *len
, const char **value
)
649 *value
= HOST_OBJECT_SUFFIX
;
654 *len
= strlen (*value
);
659 /* Return the suffix for executable files. */
662 __gnat_get_executable_suffix_ptr (int *len
, const char **value
)
664 *value
= HOST_EXECUTABLE_SUFFIX
;
668 *len
= strlen (*value
);
673 /* Return the suffix for debuggable files. Usually this is the same as the
674 executable extension. */
677 __gnat_get_debuggable_suffix_ptr (int *len
, const char **value
)
679 *value
= HOST_EXECUTABLE_SUFFIX
;
684 *len
= strlen (*value
);
689 /* Returns the OS filename and corresponding encoding. */
692 __gnat_os_filename (char *filename ATTRIBUTE_UNUSED
,
693 char *w_filename ATTRIBUTE_UNUSED
,
694 char *os_name
, int *o_length
,
695 char *encoding ATTRIBUTE_UNUSED
, int *e_length
)
697 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
698 WS2SC (os_name
, (TCHAR
*)w_filename
, (DWORD
)*o_length
);
699 *o_length
= strlen (os_name
);
700 strcpy (encoding
, "encoding=utf8");
701 *e_length
= strlen (encoding
);
703 strcpy (os_name
, filename
);
704 *o_length
= strlen (filename
);
712 __gnat_unlink (char *path
)
714 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
716 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
718 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
719 return _tunlink (wpath
);
722 return unlink (path
);
729 __gnat_rename (char *from
, char *to
)
731 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
733 TCHAR wfrom
[GNAT_MAX_PATH_LEN
], wto
[GNAT_MAX_PATH_LEN
];
735 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
);
736 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
);
737 return _trename (wfrom
, wto
);
740 return rename (from
, to
);
744 /* Changing directory. */
747 __gnat_chdir (char *path
)
749 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
751 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
753 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
754 return _tchdir (wpath
);
761 /* Removing a directory. */
764 __gnat_rmdir (char *path
)
766 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
768 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
770 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
771 return _trmdir (wpath
);
773 #elif defined (VTHREADS)
774 /* rmdir not available */
781 #if defined (_WIN32) || defined (__linux__) || defined (__sun__) \
782 || defined (__FreeBSD__) || defined(__DragonFly__) || defined (__QNX__)
783 #define HAS_TARGET_WCHAR_T
786 #ifdef HAS_TARGET_WCHAR_T
791 __gnat_fputwc(int c
, FILE *stream
)
793 #ifdef HAS_TARGET_WCHAR_T
794 return fputwc ((wchar_t)c
, stream
);
796 return fputc (c
, stream
);
801 __gnat_fopen (char *path
, char *mode
, int encoding ATTRIBUTE_UNUSED
)
803 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
804 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
807 S2WS (wmode
, mode
, 10);
809 if (encoding
== Encoding_Unspecified
)
810 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
811 else if (encoding
== Encoding_UTF8
)
812 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
814 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
816 return _tfopen (wpath
, wmode
);
819 return GNAT_FOPEN (path
, mode
);
824 __gnat_freopen (char *path
,
827 int encoding ATTRIBUTE_UNUSED
)
829 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
830 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
833 S2WS (wmode
, mode
, 10);
835 if (encoding
== Encoding_Unspecified
)
836 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
837 else if (encoding
== Encoding_UTF8
)
838 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
840 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
842 return _tfreopen (wpath
, wmode
, stream
);
844 return freopen (path
, mode
, stream
);
849 __gnat_open_read (char *path
, int fmode
)
852 int o_fmode
= O_BINARY
;
857 #if defined (__vxworks)
858 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
859 #elif defined (__MINGW32__)
861 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
863 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
864 fd
= _topen (wpath
, O_RDONLY
| o_fmode
, 0444);
867 fd
= GNAT_OPEN (path
, O_RDONLY
| o_fmode
);
870 return fd
< 0 ? -1 : fd
;
873 #if defined (__MINGW32__)
874 #define PERM (S_IREAD | S_IWRITE)
876 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
880 __gnat_open_rw (char *path
, int fmode
)
883 int o_fmode
= O_BINARY
;
888 #if defined (__MINGW32__)
890 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
892 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
893 fd
= _topen (wpath
, O_RDWR
| o_fmode
, PERM
);
896 fd
= GNAT_OPEN (path
, O_RDWR
| o_fmode
, PERM
);
899 return fd
< 0 ? -1 : fd
;
903 __gnat_open_create (char *path
, int fmode
)
906 int o_fmode
= O_BINARY
;
911 #if defined (__MINGW32__)
913 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
915 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
916 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
919 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
922 return fd
< 0 ? -1 : fd
;
926 __gnat_create_output_file (char *path
)
929 #if defined (__MINGW32__)
931 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
933 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
934 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
937 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
940 return fd
< 0 ? -1 : fd
;
944 __gnat_create_output_file_new (char *path
)
947 #if defined (__MINGW32__)
949 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
951 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
952 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
955 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
958 return fd
< 0 ? -1 : fd
;
962 __gnat_open_append (char *path
, int fmode
)
965 int o_fmode
= O_BINARY
;
970 #if defined (__MINGW32__)
972 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
974 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
975 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
978 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
981 return fd
< 0 ? -1 : fd
;
984 /* Open a new file. Return error (-1) if the file already exists. */
987 __gnat_open_new (char *path
, int fmode
)
990 int o_fmode
= O_BINARY
;
995 #if defined (__MINGW32__)
997 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
999 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1000 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1003 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1006 return fd
< 0 ? -1 : fd
;
1009 /* Open a new temp file. Return error (-1) if the file already exists. */
1012 __gnat_open_new_temp (char *path
, int fmode
)
1015 int o_fmode
= O_BINARY
;
1017 strcpy (path
, "GNAT-XXXXXX");
1019 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
1020 || defined (__linux__) || defined (__GLIBC__) || defined (__ANDROID__) \
1021 || defined (__DragonFly__) || defined (__QNX__)) && !defined (__vxworks)
1022 return mkstemp (path
);
1023 #elif defined (__Lynx__)
1026 if (mktemp (path
) == NULL
)
1033 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1034 return fd
< 0 ? -1 : fd
;
1038 __gnat_open (char *path
, int fmode
)
1042 #if defined (__MINGW32__)
1044 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1046 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1047 fd
= _topen (wpath
, fmode
, PERM
);
1050 fd
= GNAT_OPEN (path
, fmode
, PERM
);
1053 return fd
< 0 ? -1 : fd
;
1056 /****************************************************************
1057 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
1058 ** as possible from it, storing the result in a cache for later reuse
1059 ****************************************************************/
1062 __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
)
1064 GNAT_STRUCT_STAT statbuf
;
1068 /* GNAT_FSTAT returns -1 and sets errno for failure */
1069 ret
= GNAT_FSTAT (fd
, &statbuf
);
1070 error
= ret
? errno
: 0;
1073 /* __gnat_stat returns errno value directly */
1074 error
= __gnat_stat (name
, &statbuf
);
1075 ret
= error
? -1 : 0;
1079 * A missing file is reported as an attr structure with error == 0 and
1083 if (error
== 0 || error
== ENOENT
)
1086 attr
->error
= error
;
1088 attr
->regular
= (!ret
&& S_ISREG (statbuf
.st_mode
));
1089 attr
->directory
= (!ret
&& S_ISDIR (statbuf
.st_mode
));
1092 attr
->file_length
= 0;
1094 /* st_size may be 32 bits, or 64 bits which is converted to long. We
1095 don't return a useful value for files larger than 2 gigabytes in
1097 attr
->file_length
= statbuf
.st_size
; /* all systems */
1099 attr
->exists
= !ret
;
1101 #if !defined (_WIN32)
1102 /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
1103 attr
->readable
= (!ret
&& (statbuf
.st_mode
& S_IRUSR
));
1104 attr
->writable
= (!ret
&& (statbuf
.st_mode
& S_IWUSR
));
1105 attr
->executable
= (!ret
&& (statbuf
.st_mode
& S_IXUSR
));
1109 attr
->timestamp
= (OS_Time
)-1;
1111 attr
->timestamp
= (OS_Time
)statbuf
.st_mtime
;
1115 /****************************************************************
1116 ** Return the number of bytes in the specified file
1117 ****************************************************************/
1120 __gnat_file_length_attr (int fd
, char* name
, struct file_attributes
* attr
)
1122 if (attr
->file_length
== -1) {
1123 __gnat_stat_to_attr (fd
, name
, attr
);
1126 return attr
->file_length
;
1130 __gnat_file_length (int fd
)
1132 struct file_attributes attr
;
1133 __gnat_reset_attributes (&attr
);
1134 return __gnat_file_length_attr (fd
, NULL
, &attr
);
1138 __gnat_file_length_long (int fd
)
1140 struct file_attributes attr
;
1141 __gnat_reset_attributes (&attr
);
1142 return (long)__gnat_file_length_attr (fd
, NULL
, &attr
);
1146 __gnat_named_file_length (char *name
)
1148 struct file_attributes attr
;
1149 __gnat_reset_attributes (&attr
);
1150 return __gnat_file_length_attr (-1, name
, &attr
);
1153 /* Create a temporary filename and put it in string pointed to by
1157 __gnat_tmp_name (char *tmp_filename
)
1159 #if defined (__MINGW32__)
1164 /* tempnam tries to create a temporary file in directory pointed to by
1165 TMP environment variable, in c:\temp if TMP is not set, and in
1166 directory specified by P_tmpdir in stdio.h if c:\temp does not
1167 exist. The filename will be created with the prefix "gnat-". */
1169 sprintf (prefix
, "gnat-%d-", (int)getpid());
1170 pname
= (char *) _tempnam ("c:\\temp", prefix
);
1172 /* if pname is NULL, the file was not created properly, the disk is full
1173 or there is no more free temporary files */
1176 *tmp_filename
= '\0';
1178 /* If pname start with a back slash and not path information it means that
1179 the filename is valid for the current working directory. */
1181 else if (pname
[0] == '\\')
1183 strcpy (tmp_filename
, ".\\");
1184 strcat (tmp_filename
, pname
+1);
1187 strcpy (tmp_filename
, pname
);
1192 #elif defined (__linux__) || defined (__FreeBSD__) || defined (__NetBSD__) \
1193 || defined (__OpenBSD__) || defined (__GLIBC__) || defined (__ANDROID__) \
1194 || defined (__DragonFly__) || defined (__QNX__)
1195 #define MAX_SAFE_PATH 1000
1196 char *tmpdir
= getenv ("TMPDIR");
1198 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1199 a buffer overflow. */
1200 if (tmpdir
== NULL
|| strlen (tmpdir
) > MAX_SAFE_PATH
)
1202 strcpy (tmp_filename
, "/cache/gnat-XXXXXX");
1204 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
1207 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
1209 close (mkstemp(tmp_filename
));
1210 #elif defined (__vxworks) && !defined (VTHREADS)
1214 static ushort_t seed
= 0; /* used to generate unique name */
1216 /* Generate a unique name. */
1217 strcpy (tmp_filename
, "tmp");
1220 savepos
= pos
= tmp_filename
+ strlen (tmp_filename
) + index
;
1228 /* Fill up the name buffer from the last position. */
1230 for (t
= seed
; --index
>= 0; t
>>= 3)
1231 *--pos
= '0' + (t
& 07);
1233 /* Check to see if its unique, if not bump the seed and try again. */
1234 f
= fopen (tmp_filename
, "r");
1242 tmpnam (tmp_filename
);
1246 /* Open directory and returns a DIR pointer. */
1248 DIR* __gnat_opendir (char *name
)
1250 #if defined (__MINGW32__)
1251 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1253 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1254 return (DIR*)_topendir (wname
);
1257 return opendir (name
);
1261 /* Read the next entry in a directory. The returned string points somewhere
1264 #if defined (__sun__)
1265 /* For Solaris, be sure to use the 64-bit version, otherwise NFS reads may
1266 fail with EOVERFLOW if the server uses 64-bit cookies. */
1267 #define dirent dirent64
1268 #define readdir readdir64
1272 __gnat_readdir (DIR *dirp
, char *buffer
, int *len
)
1274 #if defined (__MINGW32__)
1275 struct _tdirent
*dirent
= _treaddir ((_TDIR
*)dirp
);
1279 WS2SC (buffer
, dirent
->d_name
, GNAT_MAX_PATH_LEN
);
1280 *len
= strlen (buffer
);
1287 #elif defined (HAVE_READDIR_R)
1288 /* If possible, try to use the thread-safe version. */
1289 if (readdir_r (dirp
, buffer
) != NULL
)
1291 *len
= strlen (((struct dirent
*) buffer
)->d_name
);
1292 return ((struct dirent
*) buffer
)->d_name
;
1298 struct dirent
*dirent
= (struct dirent
*) readdir (dirp
);
1302 strcpy (buffer
, dirent
->d_name
);
1303 *len
= strlen (buffer
);
1312 /* Close a directory entry. */
1314 int __gnat_closedir (DIR *dirp
)
1316 #if defined (__MINGW32__)
1317 return _tclosedir ((_TDIR
*)dirp
);
1320 return closedir (dirp
);
1324 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1327 __gnat_readdir_is_thread_safe (void)
1329 #ifdef HAVE_READDIR_R
1336 #if defined (_WIN32)
1337 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1338 static const unsigned long long w32_epoch_offset
= 11644473600ULL;
1340 /* Returns the file modification timestamp using Win32 routines which are
1341 immune against daylight saving time change. It is in fact not possible to
1342 use fstat for this purpose as the DST modify the st_mtime field of the
1346 win32_filetime (HANDLE h
)
1351 unsigned long long ull_time
;
1354 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1355 since <Jan 1st 1601>. This function must return the number of seconds
1356 since <Jan 1st 1970>. */
1358 if (GetFileTime (h
, NULL
, NULL
, &t_write
.ft_time
))
1359 return (time_t) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1363 /* As above but starting from a FILETIME. */
1365 f2t (const FILETIME
*ft
, __time64_t
*t
)
1370 unsigned long long ull_time
;
1373 t_write
.ft_time
= *ft
;
1374 *t
= (__time64_t
) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1378 /* Return a GNAT time stamp given a file name. */
1381 __gnat_file_time_name_attr (char* name
, struct file_attributes
* attr
)
1383 if (attr
->timestamp
== (OS_Time
)-2) {
1384 #if defined (_WIN32)
1386 WIN32_FILE_ATTRIBUTE_DATA fad
;
1387 __time64_t ret
= -1;
1388 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1389 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1391 if ((res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
)))
1392 f2t (&fad
.ftLastWriteTime
, &ret
);
1393 attr
->timestamp
= (OS_Time
) ret
;
1395 __gnat_stat_to_attr (-1, name
, attr
);
1398 return attr
->timestamp
;
1402 __gnat_file_time_name (char *name
)
1404 struct file_attributes attr
;
1405 __gnat_reset_attributes (&attr
);
1406 return __gnat_file_time_name_attr (name
, &attr
);
1409 /* Return a GNAT time stamp given a file descriptor. */
1412 __gnat_file_time_fd_attr (int fd
, struct file_attributes
* attr
)
1414 if (attr
->timestamp
== (OS_Time
)-2) {
1415 #if defined (_WIN32)
1416 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
1417 time_t ret
= win32_filetime (h
);
1418 attr
->timestamp
= (OS_Time
) ret
;
1421 __gnat_stat_to_attr (fd
, NULL
, attr
);
1425 return attr
->timestamp
;
1429 __gnat_file_time_fd (int fd
)
1431 struct file_attributes attr
;
1432 __gnat_reset_attributes (&attr
);
1433 return __gnat_file_time_fd_attr (fd
, &attr
);
1436 /* Set the file time stamp. */
1439 __gnat_set_file_time_name (char *name
, time_t time_stamp
)
1441 #if defined (__vxworks)
1443 /* Code to implement __gnat_set_file_time_name for these systems. */
1445 #elif defined (_WIN32)
1449 unsigned long long ull_time
;
1451 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1453 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1455 HANDLE h
= CreateFile
1456 (wname
, GENERIC_WRITE
, FILE_SHARE_WRITE
, NULL
,
1457 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
,
1459 if (h
== INVALID_HANDLE_VALUE
)
1461 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1462 t_write
.ull_time
= ((unsigned long long)time_stamp
+ w32_epoch_offset
);
1463 /* Convert to 100 nanosecond units */
1464 t_write
.ull_time
*= 10000000ULL;
1466 SetFileTime(h
, NULL
, NULL
, &t_write
.ft_time
);
1471 struct utimbuf utimbuf
;
1474 /* Set modification time to requested time. */
1475 utimbuf
.modtime
= time_stamp
;
1477 /* Set access time to now in local time. */
1478 t
= time ((time_t) 0);
1479 utimbuf
.actime
= mktime (localtime (&t
));
1481 utime (name
, &utimbuf
);
1485 /* Get the list of installed standard libraries from the
1486 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1490 __gnat_get_libraries_from_registry (void)
1492 char *result
= (char *) xmalloc (1);
1496 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
1499 DWORD name_size
, value_size
;
1506 /* First open the key. */
1507 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1509 if (res
== ERROR_SUCCESS
)
1510 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1511 KEY_READ
, ®_key
);
1513 if (res
== ERROR_SUCCESS
)
1514 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1516 if (res
== ERROR_SUCCESS
)
1517 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1519 /* If the key exists, read out all the values in it and concatenate them
1521 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1523 value_size
= name_size
= 256;
1524 res
= RegEnumValueA (reg_key
, index
, name
, &name_size
, 0,
1525 &type
, (LPBYTE
)value
, &value_size
);
1527 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1529 char *old_result
= result
;
1531 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1532 strcpy (result
, old_result
);
1533 strcat (result
, value
);
1534 strcat (result
, ";");
1539 /* Remove the trailing ";". */
1541 result
[strlen (result
) - 1] = 0;
1547 /* Query information for the given file NAME and return it in STATBUF.
1548 * Returns 0 for success, or errno value for failure.
1551 __gnat_stat (char *name
, GNAT_STRUCT_STAT
*statbuf
)
1554 WIN32_FILE_ATTRIBUTE_DATA fad
;
1555 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1560 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1561 name_len
= _tcslen (wname
);
1563 if (name_len
> GNAT_MAX_PATH_LEN
)
1566 ZeroMemory (statbuf
, sizeof(GNAT_STRUCT_STAT
));
1568 res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
);
1571 error
= GetLastError();
1573 /* Check file existence using GetFileAttributes() which does not fail on
1574 special Windows files like con:, aux:, nul: etc... */
1576 if (GetFileAttributes(wname
) != INVALID_FILE_ATTRIBUTES
) {
1577 /* Just pretend that it is a regular and readable file */
1578 statbuf
->st_mode
= S_IFREG
| S_IREAD
| S_IWRITE
;
1583 case ERROR_ACCESS_DENIED
:
1584 case ERROR_SHARING_VIOLATION
:
1585 case ERROR_LOCK_VIOLATION
:
1586 case ERROR_SHARING_BUFFER_EXCEEDED
:
1588 case ERROR_BUFFER_OVERFLOW
:
1589 return ENAMETOOLONG
;
1590 case ERROR_NOT_ENOUGH_MEMORY
:
1597 f2t (&fad
.ftCreationTime
, &statbuf
->st_ctime
);
1598 f2t (&fad
.ftLastWriteTime
, &statbuf
->st_mtime
);
1599 f2t (&fad
.ftLastAccessTime
, &statbuf
->st_atime
);
1602 (__int64
)fad
.nFileSizeLow
| (__int64
)fad
.nFileSizeHigh
<< 32;
1604 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1605 statbuf
->st_mode
= S_IREAD
;
1607 if (fad
.dwFileAttributes
& FILE_ATTRIBUTE_DIRECTORY
)
1608 statbuf
->st_mode
|= S_IFDIR
;
1610 statbuf
->st_mode
|= S_IFREG
;
1612 if (!(fad
.dwFileAttributes
& FILE_ATTRIBUTE_READONLY
))
1613 statbuf
->st_mode
|= S_IWRITE
;
1618 return GNAT_STAT (name
, statbuf
) == 0 ? 0 : errno
;
1622 /*************************************************************************
1623 ** Check whether a file exists
1624 *************************************************************************/
1627 __gnat_file_exists_attr (char* name
, struct file_attributes
* attr
)
1629 if (attr
->exists
== ATTR_UNSET
)
1630 __gnat_stat_to_attr (-1, name
, attr
);
1632 return attr
->exists
;
1636 __gnat_file_exists (char *name
)
1638 struct file_attributes attr
;
1639 __gnat_reset_attributes (&attr
);
1640 return __gnat_file_exists_attr (name
, &attr
);
1643 /**********************************************************************
1644 ** Whether name is an absolute path
1645 **********************************************************************/
1648 __gnat_is_absolute_path (char *name
, int length
)
1651 /* On VxWorks systems, an absolute path can be represented (depending on
1652 the host platform) as either /dir/file, or device:/dir/file, or
1653 device:drive_letter:/dir/file. */
1660 for (index
= 0; index
< length
; index
++)
1662 if (name
[index
] == ':' &&
1663 ((name
[index
+ 1] == '/') ||
1664 (isalpha (name
[index
+ 1]) && index
+ 2 <= length
&&
1665 name
[index
+ 2] == '/')))
1668 else if (name
[index
] == '/')
1673 return (length
!= 0) &&
1674 (*name
== '/' || *name
== DIR_SEPARATOR
1675 #if defined (WINNT) || defined(__DJGPP__)
1676 || (length
> 1 && ISALPHA (name
[0]) && name
[1] == ':')
1683 __gnat_is_regular_file_attr (char* name
, struct file_attributes
* attr
)
1685 if (attr
->regular
== ATTR_UNSET
)
1686 __gnat_stat_to_attr (-1, name
, attr
);
1688 return attr
->regular
;
1692 __gnat_is_regular_file (char *name
)
1694 struct file_attributes attr
;
1696 __gnat_reset_attributes (&attr
);
1697 return __gnat_is_regular_file_attr (name
, &attr
);
1701 __gnat_is_regular_file_fd (int fd
)
1704 GNAT_STRUCT_STAT statbuf
;
1706 ret
= GNAT_FSTAT (fd
, &statbuf
);
1707 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1711 __gnat_is_directory_attr (char* name
, struct file_attributes
* attr
)
1713 if (attr
->directory
== ATTR_UNSET
)
1714 __gnat_stat_to_attr (-1, name
, attr
);
1716 return attr
->directory
;
1720 __gnat_is_directory (char *name
)
1722 struct file_attributes attr
;
1724 __gnat_reset_attributes (&attr
);
1725 return __gnat_is_directory_attr (name
, &attr
);
1728 #if defined (_WIN32)
1730 /* Returns the same constant as GetDriveType but takes a pathname as
1734 GetDriveTypeFromPath (TCHAR
*wfullpath
)
1736 TCHAR wdrv
[MAX_PATH
];
1737 TCHAR wpath
[MAX_PATH
];
1738 TCHAR wfilename
[MAX_PATH
];
1739 TCHAR wext
[MAX_PATH
];
1741 _tsplitpath (wfullpath
, wdrv
, wpath
, wfilename
, wext
);
1743 if (_tcslen (wdrv
) != 0)
1745 /* we have a drive specified. */
1746 _tcscat (wdrv
, _T("\\"));
1747 return GetDriveType (wdrv
);
1751 /* No drive specified. */
1753 /* Is this a relative path, if so get current drive type. */
1754 if (wpath
[0] != _T('\\') ||
1755 (_tcslen (wpath
) > 2 && wpath
[0] == _T('\\')
1756 && wpath
[1] != _T('\\')))
1757 return GetDriveType (NULL
);
1759 UINT result
= GetDriveType (wpath
);
1761 /* Cannot guess the drive type, is this \\.\ ? */
1763 if (result
== DRIVE_NO_ROOT_DIR
&&
1764 _tcslen (wpath
) >= 4 && wpath
[0] == _T('\\') && wpath
[1] == _T('\\')
1765 && wpath
[2] == _T('.') && wpath
[3] == _T('\\'))
1767 if (_tcslen (wpath
) == 4)
1768 _tcscat (wpath
, wfilename
);
1770 LPTSTR p
= &wpath
[4];
1771 LPTSTR b
= _tcschr (p
, _T('\\'));
1775 /* logical drive \\.\c\dir\file */
1781 _tcscat (p
, _T(":\\"));
1783 return GetDriveType (p
);
1790 /* This MingW section contains code to work with ACL. */
1792 __gnat_check_OWNER_ACL (TCHAR
*wname
,
1793 DWORD CheckAccessDesired
,
1794 GENERIC_MAPPING CheckGenericMapping
)
1796 DWORD dwAccessDesired
, dwAccessAllowed
;
1797 PRIVILEGE_SET PrivilegeSet
;
1798 DWORD dwPrivSetSize
= sizeof (PRIVILEGE_SET
);
1799 BOOL fAccessGranted
= FALSE
;
1800 HANDLE hToken
= NULL
;
1802 PSECURITY_DESCRIPTOR pSD
= NULL
;
1805 (wname
, OWNER_SECURITY_INFORMATION
|
1806 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1809 if ((pSD
= (SECURITY_DESCRIPTOR
*) HeapAlloc
1810 (GetProcessHeap (), HEAP_ZERO_MEMORY
, nLength
)) == NULL
)
1813 /* Obtain the security descriptor. */
1815 if (!GetFileSecurity
1816 (wname
, OWNER_SECURITY_INFORMATION
|
1817 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1818 pSD
, nLength
, &nLength
))
1821 if (!ImpersonateSelf (SecurityImpersonation
))
1824 if (!OpenThreadToken
1825 (GetCurrentThread(), TOKEN_DUPLICATE
| TOKEN_QUERY
, FALSE
, &hToken
))
1828 /* Undoes the effect of ImpersonateSelf. */
1832 /* We want to test for write permissions. */
1834 dwAccessDesired
= CheckAccessDesired
;
1836 MapGenericMask (&dwAccessDesired
, &CheckGenericMapping
);
1839 (pSD
, /* security descriptor to check */
1840 hToken
, /* impersonation token */
1841 dwAccessDesired
, /* requested access rights */
1842 &CheckGenericMapping
, /* pointer to GENERIC_MAPPING */
1843 &PrivilegeSet
, /* receives privileges used in check */
1844 &dwPrivSetSize
, /* size of PrivilegeSet buffer */
1845 &dwAccessAllowed
, /* receives mask of allowed access rights */
1849 CloseHandle (hToken
);
1850 HeapFree (GetProcessHeap (), 0, pSD
);
1851 return fAccessGranted
;
1855 CloseHandle (hToken
);
1856 HeapFree (GetProcessHeap (), 0, pSD
);
1861 __gnat_set_OWNER_ACL (TCHAR
*wname
,
1862 ACCESS_MODE AccessMode
,
1863 DWORD AccessPermissions
)
1865 PACL pOldDACL
= NULL
;
1866 PACL pNewDACL
= NULL
;
1867 PSECURITY_DESCRIPTOR pSD
= NULL
;
1869 TCHAR username
[100];
1872 /* Get current user, he will act as the owner */
1874 if (!GetUserName (username
, &unsize
))
1877 if (GetNamedSecurityInfo
1880 DACL_SECURITY_INFORMATION
,
1881 NULL
, NULL
, &pOldDACL
, NULL
, &pSD
) != ERROR_SUCCESS
)
1884 BuildExplicitAccessWithName
1885 (&ea
, username
, AccessPermissions
, (ACCESS_MODE
) AccessMode
, NO_INHERITANCE
);
1887 if (AccessMode
== SET_ACCESS
)
1889 /* SET_ACCESS, we want to set an explicte set of permissions, do not
1890 merge with current DACL. */
1891 if (SetEntriesInAcl (1, &ea
, NULL
, &pNewDACL
) != ERROR_SUCCESS
)
1895 if (SetEntriesInAcl (1, &ea
, pOldDACL
, &pNewDACL
) != ERROR_SUCCESS
)
1898 if (SetNamedSecurityInfo
1899 (wname
, SE_FILE_OBJECT
,
1900 DACL_SECURITY_INFORMATION
, NULL
, NULL
, pNewDACL
, NULL
) != ERROR_SUCCESS
)
1904 LocalFree (pNewDACL
);
1907 /* Check if it is possible to use ACL for wname, the file must not be on a
1911 __gnat_can_use_acl (TCHAR
*wname
)
1913 return __gnat_use_acl
&& GetDriveTypeFromPath (wname
) != DRIVE_REMOTE
;
1916 #endif /* defined (_WIN32) */
1919 __gnat_is_readable_file_attr (char* name
, struct file_attributes
* attr
)
1921 if (attr
->readable
== ATTR_UNSET
)
1923 #if defined (_WIN32)
1924 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1925 GENERIC_MAPPING GenericMapping
;
1927 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1929 if (__gnat_can_use_acl (wname
))
1931 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1932 GenericMapping
.GenericRead
= GENERIC_READ
;
1934 __gnat_check_OWNER_ACL (wname
, FILE_READ_DATA
, GenericMapping
);
1937 attr
->readable
= GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
;
1939 __gnat_stat_to_attr (-1, name
, attr
);
1943 return attr
->readable
;
1947 __gnat_is_read_accessible_file (char *name
)
1949 #if defined (_WIN32)
1950 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1952 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1954 return !_waccess (wname
, 4);
1956 #elif defined (__vxworks)
1959 if ((fd
= open (name
, O_RDONLY
, 0)) < 0)
1965 return !access (name
, R_OK
);
1970 __gnat_is_readable_file (char *name
)
1972 struct file_attributes attr
;
1974 __gnat_reset_attributes (&attr
);
1975 return __gnat_is_readable_file_attr (name
, &attr
);
1979 __gnat_is_writable_file_attr (char* name
, struct file_attributes
* attr
)
1981 if (attr
->writable
== ATTR_UNSET
)
1983 #if defined (_WIN32)
1984 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1985 GENERIC_MAPPING GenericMapping
;
1987 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1989 if (__gnat_can_use_acl (wname
))
1991 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1992 GenericMapping
.GenericWrite
= GENERIC_WRITE
;
1994 attr
->writable
= __gnat_check_OWNER_ACL
1995 (wname
, FILE_WRITE_DATA
| FILE_APPEND_DATA
, GenericMapping
)
1996 && !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
2000 !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
2003 __gnat_stat_to_attr (-1, name
, attr
);
2007 return attr
->writable
;
2011 __gnat_is_writable_file (char *name
)
2013 struct file_attributes attr
;
2015 __gnat_reset_attributes (&attr
);
2016 return __gnat_is_writable_file_attr (name
, &attr
);
2020 __gnat_is_write_accessible_file (char *name
)
2022 #if defined (_WIN32)
2023 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2025 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2027 return !_waccess (wname
, 2);
2029 #elif defined (__vxworks)
2032 if ((fd
= open (name
, O_WRONLY
, 0)) < 0)
2038 return !access (name
, W_OK
);
2043 __gnat_is_executable_file_attr (char* name
, struct file_attributes
* attr
)
2045 if (attr
->executable
== ATTR_UNSET
)
2047 #if defined (_WIN32)
2048 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2049 GENERIC_MAPPING GenericMapping
;
2051 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2053 if (__gnat_can_use_acl (wname
))
2055 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2056 GenericMapping
.GenericExecute
= GENERIC_EXECUTE
;
2059 __gnat_check_OWNER_ACL (wname
, FILE_EXECUTE
, GenericMapping
);
2063 TCHAR
*l
, *last
= _tcsstr(wname
, _T(".exe"));
2065 /* look for last .exe */
2067 while ((l
= _tcsstr(last
+1, _T(".exe"))))
2071 GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
2072 && (last
- wname
) == (int) (_tcslen (wname
) - 4);
2075 __gnat_stat_to_attr (-1, name
, attr
);
2079 return attr
->regular
&& attr
->executable
;
2083 __gnat_is_executable_file (char *name
)
2085 struct file_attributes attr
;
2087 __gnat_reset_attributes (&attr
);
2088 return __gnat_is_executable_file_attr (name
, &attr
);
2092 __gnat_set_writable (char *name
)
2094 #if defined (_WIN32)
2095 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2097 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2099 if (__gnat_can_use_acl (wname
))
2100 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_WRITE
);
2103 (wname
, GetFileAttributes (wname
) & ~FILE_ATTRIBUTE_READONLY
);
2104 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2105 GNAT_STRUCT_STAT statbuf
;
2107 if (GNAT_STAT (name
, &statbuf
) == 0)
2109 statbuf
.st_mode
= statbuf
.st_mode
| S_IWUSR
;
2110 chmod (name
, statbuf
.st_mode
);
2115 /* must match definition in s-os_lib.ads */
2121 __gnat_set_executable (char *name
, int mode ATTRIBUTE_UNUSED
)
2123 #if defined (_WIN32)
2124 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2126 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2128 if (__gnat_can_use_acl (wname
))
2129 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_EXECUTE
);
2131 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2132 GNAT_STRUCT_STAT statbuf
;
2134 if (GNAT_STAT (name
, &statbuf
) == 0)
2137 statbuf
.st_mode
= statbuf
.st_mode
| S_IXUSR
;
2139 statbuf
.st_mode
= statbuf
.st_mode
| S_IXGRP
;
2140 if (mode
& S_OTHERS
)
2141 statbuf
.st_mode
= statbuf
.st_mode
| S_IXOTH
;
2142 chmod (name
, statbuf
.st_mode
);
2148 __gnat_set_non_writable (char *name
)
2150 #if defined (_WIN32)
2151 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2153 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2155 if (__gnat_can_use_acl (wname
))
2156 __gnat_set_OWNER_ACL
2157 (wname
, DENY_ACCESS
,
2158 FILE_WRITE_DATA
| FILE_APPEND_DATA
|
2159 FILE_WRITE_EA
| FILE_WRITE_ATTRIBUTES
);
2162 (wname
, GetFileAttributes (wname
) | FILE_ATTRIBUTE_READONLY
);
2163 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2164 GNAT_STRUCT_STAT statbuf
;
2166 if (GNAT_STAT (name
, &statbuf
) == 0)
2168 statbuf
.st_mode
= statbuf
.st_mode
& 07577;
2169 chmod (name
, statbuf
.st_mode
);
2175 __gnat_set_readable (char *name
)
2177 #if defined (_WIN32)
2178 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2180 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2182 if (__gnat_can_use_acl (wname
))
2183 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_READ
);
2185 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2186 GNAT_STRUCT_STAT statbuf
;
2188 if (GNAT_STAT (name
, &statbuf
) == 0)
2190 chmod (name
, statbuf
.st_mode
| S_IREAD
);
2196 __gnat_set_non_readable (char *name
)
2198 #if defined (_WIN32)
2199 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2201 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2203 if (__gnat_can_use_acl (wname
))
2204 __gnat_set_OWNER_ACL (wname
, DENY_ACCESS
, FILE_GENERIC_READ
);
2206 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2207 GNAT_STRUCT_STAT statbuf
;
2209 if (GNAT_STAT (name
, &statbuf
) == 0)
2211 chmod (name
, statbuf
.st_mode
& (~S_IREAD
));
2217 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED
,
2218 struct file_attributes
* attr
)
2220 if (attr
->symbolic_link
== ATTR_UNSET
)
2222 #if defined (__vxworks)
2223 attr
->symbolic_link
= 0;
2225 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2227 GNAT_STRUCT_STAT statbuf
;
2228 ret
= GNAT_LSTAT (name
, &statbuf
);
2229 attr
->symbolic_link
= (!ret
&& S_ISLNK (statbuf
.st_mode
));
2231 attr
->symbolic_link
= 0;
2234 return attr
->symbolic_link
;
2238 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED
)
2240 struct file_attributes attr
;
2242 __gnat_reset_attributes (&attr
);
2243 return __gnat_is_symbolic_link_attr (name
, &attr
);
2246 #if defined (__sun__)
2247 /* Using fork on Solaris will duplicate all the threads. fork1, which
2248 duplicates only the active thread, must be used instead, or spawning
2249 subprocess from a program with tasking will lead into numerous problems. */
2254 __gnat_portable_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2256 int status ATTRIBUTE_UNUSED
= 0;
2257 int finished ATTRIBUTE_UNUSED
;
2258 int pid ATTRIBUTE_UNUSED
;
2260 #if defined (__vxworks) || defined(__PikeOS__)
2263 #elif defined (__DJGPP__) || defined (_WIN32)
2264 /* args[0] must be quotes as it could contain a full pathname with spaces */
2265 char *args_0
= args
[0];
2266 args
[0] = (char *)xmalloc (strlen (args_0
) + 3);
2267 strcpy (args
[0], "\"");
2268 strcat (args
[0], args_0
);
2269 strcat (args
[0], "\"");
2271 status
= spawnvp (P_WAIT
, args_0
, (char ** const)args
);
2273 /* restore previous value */
2275 args
[0] = (char *)args_0
;
2291 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2296 finished
= waitpid (pid
, &status
, 0);
2298 if (finished
!= pid
|| WIFEXITED (status
) == 0)
2301 return WEXITSTATUS (status
);
2307 /* Create a copy of the given file descriptor.
2308 Return -1 if an error occurred. */
2311 __gnat_dup (int oldfd
)
2313 #if defined (__vxworks) && !defined (__RTP__)
2314 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2322 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2323 Return -1 if an error occurred. */
2326 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED
, int newfd ATTRIBUTE_UNUSED
)
2328 #if defined (__vxworks) && !defined (__RTP__)
2329 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2332 #elif defined (__PikeOS__)
2333 /* Not supported. */
2335 #elif defined (_WIN32)
2336 /* Special case when oldfd and newfd are identical and are the standard
2337 input, output or error as this makes Windows XP hangs. Note that we
2338 do that only for standard file descriptors that are known to be valid. */
2339 if (oldfd
== newfd
&& newfd
>= 0 && newfd
<= 2)
2342 return dup2 (oldfd
, newfd
);
2344 return dup2 (oldfd
, newfd
);
2349 __gnat_number_of_cpus (void)
2353 #if defined (__linux__) || defined (__sun__) || defined (_AIX) \
2354 || defined (__APPLE__) || defined (__FreeBSD__) || defined (__OpenBSD__) \
2355 || defined (__DragonFly__) || defined (__NetBSD__)
2356 cores
= (int) sysconf (_SC_NPROCESSORS_ONLN
);
2358 #elif defined (__QNX__)
2359 cores
= (int) _syspage_ptr
->num_cpu
;
2361 #elif defined (__hpux__)
2362 struct pst_dynamic psd
;
2363 if (pstat_getdynamic (&psd
, sizeof (psd
), 1, 0) != -1)
2364 cores
= (int) psd
.psd_proc_cnt
;
2366 #elif defined (_WIN32)
2367 SYSTEM_INFO sysinfo
;
2368 GetSystemInfo (&sysinfo
);
2369 cores
= (int) sysinfo
.dwNumberOfProcessors
;
2371 #elif defined (_WRS_CONFIG_SMP)
2372 unsigned int vxCpuConfiguredGet (void);
2374 cores
= vxCpuConfiguredGet ();
2381 /* WIN32 code to implement a wait call that wait for any child process. */
2383 #if defined (_WIN32)
2385 /* Synchronization code, to be thread safe. */
2389 /* For the Cert run times on native Windows we use dummy functions
2390 for locking and unlocking tasks since we do not support multiple
2391 threads on this configuration (Cert run time on native Windows). */
2393 static void EnterCS (void) {}
2394 static void LeaveCS (void) {}
2395 static void SignalListChanged (void) {}
2399 CRITICAL_SECTION ProcListCS
;
2400 HANDLE ProcListEvt
= NULL
;
2402 static void EnterCS (void)
2404 EnterCriticalSection(&ProcListCS
);
2407 static void LeaveCS (void)
2409 LeaveCriticalSection(&ProcListCS
);
2412 static void SignalListChanged (void)
2414 SetEvent (ProcListEvt
);
2419 static HANDLE
*HANDLES_LIST
= NULL
;
2420 static int *PID_LIST
= NULL
, plist_length
= 0, plist_max_length
= 0;
2423 add_handle (HANDLE h
, int pid
)
2425 /* -------------------- critical section -------------------- */
2428 if (plist_length
== plist_max_length
)
2430 plist_max_length
+= 100;
2432 (HANDLE
*) xrealloc (HANDLES_LIST
, sizeof (HANDLE
) * plist_max_length
);
2434 (int *) xrealloc (PID_LIST
, sizeof (int) * plist_max_length
);
2437 HANDLES_LIST
[plist_length
] = h
;
2438 PID_LIST
[plist_length
] = pid
;
2441 SignalListChanged();
2443 /* -------------------- critical section -------------------- */
2447 __gnat_win32_remove_handle (HANDLE h
, int pid
)
2452 /* -------------------- critical section -------------------- */
2455 for (j
= 0; j
< plist_length
; j
++)
2457 if ((HANDLES_LIST
[j
] == h
) || (PID_LIST
[j
] == pid
))
2461 HANDLES_LIST
[j
] = HANDLES_LIST
[plist_length
];
2462 PID_LIST
[j
] = PID_LIST
[plist_length
];
2469 /* -------------------- critical section -------------------- */
2472 SignalListChanged();
2478 win32_no_block_spawn (char *command
, char *args
[], HANDLE
*h
, int *pid
)
2482 PROCESS_INFORMATION PI
;
2483 SECURITY_ATTRIBUTES SA
;
2488 /* compute the total command line length */
2492 csize
+= strlen (args
[k
]) + 1;
2496 full_command
= (char *) xmalloc (csize
);
2499 SI
.cb
= sizeof (STARTUPINFO
);
2500 SI
.lpReserved
= NULL
;
2501 SI
.lpReserved2
= NULL
;
2502 SI
.lpDesktop
= NULL
;
2506 SI
.wShowWindow
= SW_HIDE
;
2508 /* Security attributes. */
2509 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
2510 SA
.bInheritHandle
= TRUE
;
2511 SA
.lpSecurityDescriptor
= NULL
;
2513 /* Prepare the command string. */
2514 strcpy (full_command
, command
);
2515 strcat (full_command
, " ");
2520 strcat (full_command
, args
[k
]);
2521 strcat (full_command
, " ");
2526 int wsize
= csize
* 2;
2527 TCHAR
*wcommand
= (TCHAR
*) xmalloc (wsize
);
2529 S2WSC (wcommand
, full_command
, wsize
);
2531 free (full_command
);
2533 result
= CreateProcess
2534 (NULL
, wcommand
, &SA
, NULL
, TRUE
,
2535 GetPriorityClass (GetCurrentProcess()), NULL
, NULL
, &SI
, &PI
);
2542 CloseHandle (PI
.hThread
);
2544 *pid
= PI
.dwProcessId
;
2554 win32_wait (int *status
)
2556 DWORD exitcode
, pid
;
2567 if (plist_length
== 0)
2573 /* -------------------- critical section -------------------- */
2576 /* ??? We can't wait for more than MAXIMUM_WAIT_OBJECTS due to a Win32
2578 if (plist_length
< MAXIMUM_WAIT_OBJECTS
)
2579 hl_len
= plist_length
;
2587 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
);
2588 memmove (hl
, HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2589 pidl
= (int *) xmalloc (sizeof (int) * hl_len
);
2590 memmove (pidl
, PID_LIST
, sizeof (int) * hl_len
);
2592 /* Note that index 0 contains the event handle that is signaled when the
2593 process list has changed */
2594 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * (hl_len
+ 1));
2595 hl
[0] = ProcListEvt
;
2596 memmove (&hl
[1], HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2597 pidl
= (int *) xmalloc (sizeof (int) * (hl_len
+ 1));
2598 memmove (&pidl
[1], PID_LIST
, sizeof (int) * hl_len
);
2603 /* -------------------- critical section -------------------- */
2605 res
= WaitForMultipleObjects (hl_len
, hl
, FALSE
, INFINITE
);
2607 /* If there was an error, exit now */
2608 if (res
== WAIT_FAILED
)
2616 /* if the ProcListEvt has been signaled then the list of processes has been
2617 updated to add or remove a handle, just loop over */
2619 if (res
- WAIT_OBJECT_0
== 0)
2626 /* Handle two distinct groups of return codes: finished waits and abandoned
2629 if (res
< WAIT_ABANDONED_0
)
2630 pos
= res
- WAIT_OBJECT_0
;
2632 pos
= res
- WAIT_ABANDONED_0
;
2635 GetExitCodeProcess (h
, &exitcode
);
2638 found
= __gnat_win32_remove_handle (h
, -1);
2643 /* if not found another process waiting has already handled this process */
2650 *status
= (int) exitcode
;
2657 __gnat_portable_no_block_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2660 #if defined (__vxworks) || defined (__PikeOS__)
2661 /* Not supported. */
2664 #elif defined(__DJGPP__)
2665 if (spawnvp (P_WAIT
, args
[0], args
) != 0)
2670 #elif defined (_WIN32)
2675 win32_no_block_spawn (args
[0], args
, &h
, &pid
);
2678 add_handle (h
, pid
);
2691 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2701 __gnat_portable_wait (int *process_status
)
2706 #if defined (__vxworks) || defined (__PikeOS__)
2707 /* Not sure what to do here, so do nothing but return zero. */
2709 #elif defined (_WIN32)
2711 pid
= win32_wait (&status
);
2713 #elif defined (__DJGPP__)
2714 /* Child process has already ended in case of DJGPP.
2715 No need to do anything. Just return success. */
2718 pid
= waitpid (-1, &status
, 0);
2719 status
= status
& 0xffff;
2722 *process_status
= status
;
2727 __gnat_portable_no_block_wait (int *process_status
)
2732 #if defined (__vxworks) || defined (__PikeOS__) || defined (_WIN32)
2733 /* Not supported. */
2738 pid
= waitpid (-1, &status
, WNOHANG
);
2739 status
= status
& 0xffff;
2742 *process_status
= status
;
2747 __gnat_os_exit (int status
)
2753 __gnat_current_process_id (void)
2755 #if defined (__vxworks) || defined (__PikeOS__)
2758 #elif defined (_WIN32)
2760 return (int)GetCurrentProcessId();
2764 return (int)getpid();
2768 /* Locate file on path, that matches a predicate */
2771 __gnat_locate_file_with_predicate (char *file_name
, char *path_val
,
2772 int (*predicate
)(char *))
2775 char *file_path
= (char *) alloca (strlen (file_name
) + 1);
2778 /* Return immediately if file_name is empty */
2780 if (*file_name
== '\0')
2783 /* Remove quotes around file_name if present */
2789 strcpy (file_path
, ptr
);
2791 ptr
= file_path
+ strlen (file_path
) - 1;
2796 /* Handle absolute pathnames. */
2798 absolute
= __gnat_is_absolute_path (file_path
, strlen (file_name
));
2802 if (predicate (file_path
))
2803 return xstrdup (file_path
);
2808 /* If file_name include directory separator(s), try it first as
2809 a path name relative to the current directory */
2810 for (ptr
= file_name
; *ptr
&& *ptr
!= '/' && *ptr
!= DIR_SEPARATOR
; ptr
++)
2815 if (predicate (file_name
))
2816 return xstrdup (file_name
);
2823 /* The result has to be smaller than path_val + file_name. */
2825 (char *) alloca (strlen (path_val
) + strlen (file_name
) + 2);
2829 /* Skip the starting quote */
2831 if (*path_val
== '"')
2834 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
2835 *ptr
++ = *path_val
++;
2837 /* If directory is empty, it is the current directory*/
2839 if (ptr
== file_path
)
2846 /* Skip the ending quote */
2851 if (*ptr
!= '/' && *ptr
!= DIR_SEPARATOR
)
2852 *++ptr
= DIR_SEPARATOR
;
2854 strcpy (++ptr
, file_name
);
2856 if (predicate (file_path
))
2857 return xstrdup (file_path
);
2862 /* Skip path separator */
2871 /* Locate an executable file, give a Path value. */
2874 __gnat_locate_executable_file (char *file_name
, char *path_val
)
2876 return __gnat_locate_file_with_predicate
2877 (file_name
, path_val
, &__gnat_is_executable_file
);
2880 /* Locate a regular file, give a Path value. */
2883 __gnat_locate_regular_file (char *file_name
, char *path_val
)
2885 return __gnat_locate_file_with_predicate
2886 (file_name
, path_val
, &__gnat_is_regular_file
);
2889 /* Locate an executable given a Path argument. This routine is only used by
2890 gnatbl and should not be used otherwise. Use locate_exec_on_path
2894 __gnat_locate_exec (char *exec_name
, char *path_val
)
2897 if (!strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
2899 char *full_exec_name
=
2901 (strlen (exec_name
) + strlen (HOST_EXECUTABLE_SUFFIX
) + 1);
2903 strcpy (full_exec_name
, exec_name
);
2904 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
2905 ptr
= __gnat_locate_executable_file (full_exec_name
, path_val
);
2908 return __gnat_locate_executable_file (exec_name
, path_val
);
2912 return __gnat_locate_executable_file (exec_name
, path_val
);
2915 /* Locate an executable using the Systems default PATH. */
2918 __gnat_locate_exec_on_path (char *exec_name
)
2922 #if defined (_WIN32)
2923 TCHAR
*wpath_val
= _tgetenv (_T("PATH"));
2925 /* In Win32 systems we expand the PATH as for XP environment
2926 variables are not automatically expanded. We also prepend the
2927 ".;" to the path to match normal NT path search semantics */
2929 #define EXPAND_BUFFER_SIZE 32767
2931 wapath_val
= (TCHAR
*) alloca (EXPAND_BUFFER_SIZE
);
2933 wapath_val
[0] = '.';
2934 wapath_val
[1] = ';';
2936 DWORD res
= ExpandEnvironmentStrings
2937 (wpath_val
, &wapath_val
[2], EXPAND_BUFFER_SIZE
- 2);
2939 if (!res
) wapath_val
[0] = _T('\0');
2941 apath_val
= (char *) alloca (EXPAND_BUFFER_SIZE
);
2943 WS2SC (apath_val
, wapath_val
, EXPAND_BUFFER_SIZE
);
2946 const char *path_val
= getenv ("PATH");
2948 /* If PATH is not defined, proceed with __gnat_locate_exec anyway, so we can
2949 find files that contain directory names. */
2951 if (path_val
== NULL
) path_val
= "";
2952 apath_val
= (char *) alloca (strlen (path_val
) + 1);
2953 strcpy (apath_val
, path_val
);
2956 return __gnat_locate_exec (exec_name
, apath_val
);
2959 /* Dummy functions for Osint import for non-VMS systems.
2960 ??? To be removed. */
2963 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED
,
2964 int onlydirs ATTRIBUTE_UNUSED
)
2970 __gnat_to_canonical_file_list_next (void)
2972 static char empty
[] = "";
2977 __gnat_to_canonical_file_list_free (void)
2982 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2988 __gnat_to_canonical_file_spec (char *filespec
)
2994 __gnat_to_canonical_path_spec (char *pathspec
)
3000 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
3006 __gnat_to_host_file_spec (char *filespec
)
3012 __gnat_adjust_os_resource_limits (void)
3016 #if defined (__mips_vxworks)
3020 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
3024 #if defined (_WIN32)
3025 int __gnat_argument_needs_quote
= 1;
3027 int __gnat_argument_needs_quote
= 0;
3030 /* This option is used to enable/disable object files handling from the
3031 binder file by the GNAT Project module. For example, this is disabled on
3032 Windows (prior to GCC 3.4) as it is already done by the mdll module.
3033 Stating with GCC 3.4 the shared libraries are not based on mdll
3034 anymore as it uses the GCC's -shared option */
3035 #if defined (_WIN32) \
3036 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
3037 int __gnat_prj_add_obj_files
= 0;
3039 int __gnat_prj_add_obj_files
= 1;
3042 /* char used as prefix/suffix for environment variables */
3043 #if defined (_WIN32)
3044 char __gnat_environment_char
= '%';
3046 char __gnat_environment_char
= '$';
3049 /* This functions copy the file attributes from a source file to a
3052 mode = 0 : In this mode copy only the file time stamps (last access and
3053 last modification time stamps).
3055 mode = 1 : In this mode, time stamps and read/write/execute attributes are
3058 mode = 2 : In this mode, only read/write/execute attributes are copied
3060 Returns 0 if operation was successful and -1 in case of error. */
3063 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED
, char *to ATTRIBUTE_UNUSED
,
3064 int mode ATTRIBUTE_UNUSED
)
3066 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
3069 #elif defined (_WIN32)
3070 TCHAR wfrom
[GNAT_MAX_PATH_LEN
+ 2];
3071 TCHAR wto
[GNAT_MAX_PATH_LEN
+ 2];
3073 FILETIME fct
, flat
, flwt
;
3076 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
+ 2);
3077 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
+ 2);
3079 /* Do we need to copy the timestamp ? */
3082 /* retrieve from times */
3085 (wfrom
, GENERIC_READ
, 0, NULL
, OPEN_EXISTING
,
3086 FILE_ATTRIBUTE_NORMAL
, NULL
);
3088 if (hfrom
== INVALID_HANDLE_VALUE
)
3091 res
= GetFileTime (hfrom
, &fct
, &flat
, &flwt
);
3093 CloseHandle (hfrom
);
3098 /* retrieve from times */
3101 (wto
, GENERIC_WRITE
, 0, NULL
, OPEN_EXISTING
,
3102 FILE_ATTRIBUTE_NORMAL
, NULL
);
3104 if (hto
== INVALID_HANDLE_VALUE
)
3107 res
= SetFileTime (hto
, NULL
, &flat
, &flwt
);
3115 /* Do we need to copy the permissions ? */
3116 /* Set file attributes in full mode. */
3120 DWORD attribs
= GetFileAttributes (wfrom
);
3122 if (attribs
== INVALID_FILE_ATTRIBUTES
)
3125 res
= SetFileAttributes (wto
, attribs
);
3133 GNAT_STRUCT_STAT fbuf
;
3134 struct utimbuf tbuf
;
3136 if (GNAT_STAT (from
, &fbuf
) == -1) {
3140 /* Do we need to copy timestamp ? */
3142 tbuf
.actime
= fbuf
.st_atime
;
3143 tbuf
.modtime
= fbuf
.st_mtime
;
3145 if (utime (to
, &tbuf
) == -1) {
3150 /* Do we need to copy file permissions ? */
3151 if (mode
!= 0 && (chmod (to
, fbuf
.st_mode
) == -1)) {
3160 __gnat_lseek (int fd
, long offset
, int whence
)
3162 return (int) lseek (fd
, offset
, whence
);
3165 /* This function returns the major version number of GCC being used. */
3167 get_gcc_version (void)
3172 return (int) (version_string
[0] - '0');
3177 * Set Close_On_Exec as indicated.
3178 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
3182 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED
,
3183 int close_on_exec_p ATTRIBUTE_UNUSED
)
3185 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3186 int flags
= fcntl (fd
, F_GETFD
, 0);
3189 if (close_on_exec_p
)
3190 flags
|= FD_CLOEXEC
;
3192 flags
&= ~FD_CLOEXEC
;
3193 return fcntl (fd
, F_SETFD
, flags
);
3194 #elif defined(_WIN32)
3195 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
3196 if (h
== (HANDLE
) -1)
3198 if (close_on_exec_p
)
3199 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
, 0);
3200 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
,
3201 HANDLE_FLAG_INHERIT
);
3203 /* TODO: Unimplemented. */
3208 /* Indicates if platforms supports automatic initialization through the
3209 constructor mechanism */
3211 __gnat_binder_supports_auto_init (void)
3216 /* Indicates that Stand-Alone Libraries are automatically initialized through
3217 the constructor mechanism */
3219 __gnat_sals_init_using_constructors (void)
3221 #if defined (__vxworks) || defined (__Lynx__)
3228 #if defined (__linux__) || defined (__ANDROID__)
3229 /* There is no function in the glibc to retrieve the LWP of the current
3230 thread. We need to do a system call in order to retrieve this
3232 #include <sys/syscall.h>
3234 __gnat_lwp_self (void)
3236 return (void *) syscall (__NR_gettid
);
3240 #if defined (__APPLE__)
3241 #include <mach/thread_info.h>
3242 #include <mach/mach_init.h>
3243 #include <mach/thread_act.h>
3245 /* System-wide thread identifier. Note it could be truncated on 32 bit
3247 Previously was: pthread_mach_thread_np (pthread_self ()). */
3249 __gnat_lwp_self (void)
3251 thread_identifier_info_data_t data
;
3252 mach_msg_type_number_t count
= THREAD_IDENTIFIER_INFO_COUNT
;
3255 kret
= thread_info (mach_thread_self (), THREAD_IDENTIFIER_INFO
,
3256 (thread_info_t
) &data
, &count
);
3257 if (kret
== KERN_SUCCESS
)
3258 return (void *)(uintptr_t)data
.thread_id
;
3264 #if defined (__linux__)
3267 /* glibc versions earlier than 2.7 do not define the routines to handle
3268 dynamically allocated CPU sets. For these targets, we use the static
3273 /* Dynamic cpu sets */
3276 __gnat_cpu_alloc (size_t count
)
3278 return CPU_ALLOC (count
);
3282 __gnat_cpu_alloc_size (size_t count
)
3284 return CPU_ALLOC_SIZE (count
);
3288 __gnat_cpu_free (cpu_set_t
*set
)
3294 __gnat_cpu_zero (size_t count
, cpu_set_t
*set
)
3296 CPU_ZERO_S (count
, set
);
3300 __gnat_cpu_set (int cpu
, size_t count
, cpu_set_t
*set
)
3302 /* Ada handles CPU numbers starting from 1, while C identifies the first
3303 CPU by a 0, so we need to adjust. */
3304 CPU_SET_S (cpu
- 1, count
, set
);
3307 #else /* !CPU_ALLOC */
3309 /* Static cpu sets */
3312 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED
)
3314 return (cpu_set_t
*) xmalloc (sizeof (cpu_set_t
));
3318 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED
)
3320 return sizeof (cpu_set_t
);
3324 __gnat_cpu_free (cpu_set_t
*set
)
3330 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3336 __gnat_cpu_set (int cpu
, size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3338 /* Ada handles CPU numbers starting from 1, while C identifies the first
3339 CPU by a 0, so we need to adjust. */
3340 CPU_SET (cpu
- 1, set
);
3342 #endif /* !CPU_ALLOC */
3343 #endif /* __linux__ */
3345 /* Return the load address of the executable, or 0 if not known. In the
3346 specific case of error, (void *)-1 can be returned. Beware: this unit may
3347 be in a shared library. As low-level units are needed, we allow #include
3350 #if defined (__APPLE__)
3351 #include <mach-o/dyld.h>
3355 __gnat_get_executable_load_address (void)
3357 #if defined (__APPLE__)
3358 return _dyld_get_image_header (0);
3360 #elif 0 && defined (__linux__)
3361 /* Currently disabled as it needs at least -ldl. */
3362 struct link_map
*map
= _r_debug
.r_map
;
3364 return (const void *)map
->l_addr
;
3372 __gnat_kill (int pid
, int sig
, int close ATTRIBUTE_UNUSED
)
3375 HANDLE h
= OpenProcess (PROCESS_ALL_ACCESS
, FALSE
, pid
);
3380 TerminateProcess (h
, 1);
3382 else if (sig
== SIGINT
)
3383 GenerateConsoleCtrlEvent (CTRL_C_EVENT
, pid
);
3384 else if (sig
== SIGBREAK
)
3385 GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT
, pid
);
3386 /* ??? The last two alternatives don't really work. SIGBREAK requires setting
3387 up process groups at start time which we don't do; treating SIGINT is just
3388 not possible apparently. So we really only support signal 9. Fortunately
3389 that's all we use in GNAT.Expect */
3392 #elif defined (__vxworks)
3393 /* Not implemented */
3399 void __gnat_killprocesstree (int pid
, int sig_num
)
3404 memset(&pe
, 0, sizeof(PROCESSENTRY32
));
3405 pe
.dwSize
= sizeof(PROCESSENTRY32
);
3407 HANDLE hSnap
= CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS
, 0);
3409 /* cannot take snapshot, just kill the parent process */
3411 if (hSnap
== INVALID_HANDLE_VALUE
)
3413 __gnat_kill (pid
, sig_num
, 1);
3417 if (Process32First(hSnap
, &pe
))
3419 BOOL bContinue
= TRUE
;
3421 /* kill child processes first */
3425 if (pe
.th32ParentProcessID
== (DWORD
)pid
)
3426 __gnat_killprocesstree (pe
.th32ProcessID
, sig_num
);
3428 bContinue
= Process32Next (hSnap
, &pe
);
3432 CloseHandle (hSnap
);
3436 __gnat_kill (pid
, sig_num
, 1);
3438 #elif defined (__vxworks)
3439 /* not implemented */
3441 #elif defined (__linux__)
3445 /* read all processes' pid and ppid */
3447 dir
= opendir ("/proc");
3449 /* cannot open proc, just kill the parent process */
3453 __gnat_kill (pid
, sig_num
, 1);
3457 /* kill child processes first */
3459 while ((d
= readdir (dir
)) != NULL
)
3461 if ((d
->d_type
& DT_DIR
) == DT_DIR
)
3466 /* read /proc/<PID>/stat */
3468 if (strlen (d
->d_name
) >= sizeof (statfile
) - strlen ("/proc//stat"))
3470 strcpy (statfile
, "/proc/");
3471 strcat (statfile
, d
->d_name
);
3472 strcat (statfile
, "/stat");
3474 FILE *fd
= fopen (statfile
, "r");
3478 const int match
= fscanf (fd
, "%d %*s %*s %d", &_pid
, &_ppid
);
3481 if (match
== 2 && _ppid
== pid
)
3482 __gnat_killprocesstree (_pid
, sig_num
);
3491 __gnat_kill (pid
, sig_num
, 1);
3493 __gnat_kill (pid
, sig_num
, 1);
3495 /* Note on Solaris it is possible to read /proc/<PID>/status.
3496 The 5th and 6th words are the pid and the 7th and 8th the ppid.
3497 See: /usr/include/sys/procfs.h (struct pstatus).