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
;
669 *len
= strlen (*value
);
674 /* Return the suffix for debuggable files. Usually this is the same as the
675 executable extension. */
678 __gnat_get_debuggable_suffix_ptr (int *len
, const char **value
)
680 *value
= HOST_EXECUTABLE_SUFFIX
;
685 *len
= strlen (*value
);
690 /* Returns the OS filename and corresponding encoding. */
693 __gnat_os_filename (char *filename ATTRIBUTE_UNUSED
,
694 char *w_filename ATTRIBUTE_UNUSED
,
695 char *os_name
, int *o_length
,
696 char *encoding ATTRIBUTE_UNUSED
, int *e_length
)
698 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
699 WS2SC (os_name
, (TCHAR
*)w_filename
, (DWORD
)*o_length
);
700 *o_length
= strlen (os_name
);
701 strcpy (encoding
, "encoding=utf8");
702 *e_length
= strlen (encoding
);
704 strcpy (os_name
, filename
);
705 *o_length
= strlen (filename
);
713 __gnat_unlink (char *path
)
715 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
717 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
719 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
720 return _tunlink (wpath
);
723 return unlink (path
);
730 __gnat_rename (char *from
, char *to
)
732 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
734 TCHAR wfrom
[GNAT_MAX_PATH_LEN
], wto
[GNAT_MAX_PATH_LEN
];
736 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
);
737 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
);
738 return _trename (wfrom
, wto
);
741 return rename (from
, to
);
745 /* Changing directory. */
748 __gnat_chdir (char *path
)
750 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
752 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
754 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
755 return _tchdir (wpath
);
762 /* Removing a directory. */
765 __gnat_rmdir (char *path
)
767 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
769 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
771 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
772 return _trmdir (wpath
);
774 #elif defined (VTHREADS)
775 /* rmdir not available */
782 #if defined (_WIN32) || defined (__linux__) || defined (__sun__) \
783 || defined (__FreeBSD__) || defined(__DragonFly__) || defined (__QNX__)
784 #define HAS_TARGET_WCHAR_T
787 #ifdef HAS_TARGET_WCHAR_T
792 __gnat_fputwc(int c
, FILE *stream
)
794 #ifdef HAS_TARGET_WCHAR_T
795 return fputwc ((wchar_t)c
, stream
);
797 return fputc (c
, stream
);
802 __gnat_fopen (char *path
, char *mode
, int encoding ATTRIBUTE_UNUSED
)
804 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
805 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
808 S2WS (wmode
, mode
, 10);
810 if (encoding
== Encoding_Unspecified
)
811 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
812 else if (encoding
== Encoding_UTF8
)
813 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
815 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
817 return _tfopen (wpath
, wmode
);
820 return GNAT_FOPEN (path
, mode
);
825 __gnat_freopen (char *path
,
828 int encoding ATTRIBUTE_UNUSED
)
830 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
831 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
834 S2WS (wmode
, mode
, 10);
836 if (encoding
== Encoding_Unspecified
)
837 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
838 else if (encoding
== Encoding_UTF8
)
839 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
841 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
843 return _tfreopen (wpath
, wmode
, stream
);
845 return freopen (path
, mode
, stream
);
850 __gnat_open_read (char *path
, int fmode
)
853 int o_fmode
= O_BINARY
;
858 #if defined (__vxworks)
859 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
860 #elif defined (__MINGW32__)
862 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
864 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
865 fd
= _topen (wpath
, O_RDONLY
| o_fmode
, 0444);
868 fd
= GNAT_OPEN (path
, O_RDONLY
| o_fmode
);
871 return fd
< 0 ? -1 : fd
;
874 #if defined (__MINGW32__)
875 #define PERM (S_IREAD | S_IWRITE)
877 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
881 __gnat_open_rw (char *path
, int fmode
)
884 int o_fmode
= O_BINARY
;
889 #if defined (__MINGW32__)
891 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
893 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
894 fd
= _topen (wpath
, O_RDWR
| o_fmode
, PERM
);
897 fd
= GNAT_OPEN (path
, O_RDWR
| o_fmode
, PERM
);
900 return fd
< 0 ? -1 : fd
;
904 __gnat_open_create (char *path
, int fmode
)
907 int o_fmode
= O_BINARY
;
912 #if defined (__MINGW32__)
914 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
916 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
917 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
920 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
923 return fd
< 0 ? -1 : fd
;
927 __gnat_create_output_file (char *path
)
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_TEXT
, PERM
);
938 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
941 return fd
< 0 ? -1 : fd
;
945 __gnat_create_output_file_new (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
| O_EXCL
, PERM
);
956 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
959 return fd
< 0 ? -1 : fd
;
963 __gnat_open_append (char *path
, int fmode
)
966 int o_fmode
= O_BINARY
;
971 #if defined (__MINGW32__)
973 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
975 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
976 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
979 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
982 return fd
< 0 ? -1 : fd
;
985 /* Open a new file. Return error (-1) if the file already exists. */
988 __gnat_open_new (char *path
, int fmode
)
991 int o_fmode
= O_BINARY
;
996 #if defined (__MINGW32__)
998 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1000 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1001 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1004 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1007 return fd
< 0 ? -1 : fd
;
1010 /* Open a new temp file. Return error (-1) if the file already exists. */
1013 __gnat_open_new_temp (char *path
, int fmode
)
1016 int o_fmode
= O_BINARY
;
1018 strcpy (path
, "GNAT-XXXXXX");
1020 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
1021 || defined (__linux__) || defined (__GLIBC__) || defined (__ANDROID__) \
1022 || defined (__DragonFly__) || defined (__QNX__)) && !defined (__vxworks)
1023 return mkstemp (path
);
1024 #elif defined (__Lynx__)
1027 if (mktemp (path
) == NULL
)
1034 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1035 return fd
< 0 ? -1 : fd
;
1039 __gnat_open (char *path
, int fmode
)
1043 #if defined (__MINGW32__)
1045 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1047 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1048 fd
= _topen (wpath
, fmode
, PERM
);
1051 fd
= GNAT_OPEN (path
, fmode
, PERM
);
1054 return fd
< 0 ? -1 : fd
;
1057 /****************************************************************
1058 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
1059 ** as possible from it, storing the result in a cache for later reuse
1060 ****************************************************************/
1063 __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
)
1065 GNAT_STRUCT_STAT statbuf
;
1069 /* GNAT_FSTAT returns -1 and sets errno for failure */
1070 ret
= GNAT_FSTAT (fd
, &statbuf
);
1071 error
= ret
? errno
: 0;
1074 /* __gnat_stat returns errno value directly */
1075 error
= __gnat_stat (name
, &statbuf
);
1076 ret
= error
? -1 : 0;
1080 * A missing file is reported as an attr structure with error == 0 and
1084 if (error
== 0 || error
== ENOENT
)
1087 attr
->error
= error
;
1089 attr
->regular
= (!ret
&& S_ISREG (statbuf
.st_mode
));
1090 attr
->directory
= (!ret
&& S_ISDIR (statbuf
.st_mode
));
1093 attr
->file_length
= 0;
1095 /* st_size may be 32 bits, or 64 bits which is converted to long. We
1096 don't return a useful value for files larger than 2 gigabytes in
1098 attr
->file_length
= statbuf
.st_size
; /* all systems */
1100 attr
->exists
= !ret
;
1102 #if !defined (_WIN32)
1103 /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
1104 attr
->readable
= (!ret
&& (statbuf
.st_mode
& S_IRUSR
));
1105 attr
->writable
= (!ret
&& (statbuf
.st_mode
& S_IWUSR
));
1106 attr
->executable
= (!ret
&& (statbuf
.st_mode
& S_IXUSR
));
1110 attr
->timestamp
= (OS_Time
)-1;
1112 attr
->timestamp
= (OS_Time
)statbuf
.st_mtime
;
1116 /****************************************************************
1117 ** Return the number of bytes in the specified file
1118 ****************************************************************/
1121 __gnat_file_length_attr (int fd
, char* name
, struct file_attributes
* attr
)
1123 if (attr
->file_length
== -1) {
1124 __gnat_stat_to_attr (fd
, name
, attr
);
1127 return attr
->file_length
;
1131 __gnat_file_length (int fd
)
1133 struct file_attributes attr
;
1134 __gnat_reset_attributes (&attr
);
1135 return __gnat_file_length_attr (fd
, NULL
, &attr
);
1139 __gnat_file_length_long (int fd
)
1141 struct file_attributes attr
;
1142 __gnat_reset_attributes (&attr
);
1143 return (long)__gnat_file_length_attr (fd
, NULL
, &attr
);
1147 __gnat_named_file_length (char *name
)
1149 struct file_attributes attr
;
1150 __gnat_reset_attributes (&attr
);
1151 return __gnat_file_length_attr (-1, name
, &attr
);
1154 /* Create a temporary filename and put it in string pointed to by
1158 __gnat_tmp_name (char *tmp_filename
)
1160 #if defined (__MINGW32__)
1165 /* tempnam tries to create a temporary file in directory pointed to by
1166 TMP environment variable, in c:\temp if TMP is not set, and in
1167 directory specified by P_tmpdir in stdio.h if c:\temp does not
1168 exist. The filename will be created with the prefix "gnat-". */
1170 sprintf (prefix
, "gnat-%d-", (int)getpid());
1171 pname
= (char *) _tempnam ("c:\\temp", prefix
);
1173 /* if pname is NULL, the file was not created properly, the disk is full
1174 or there is no more free temporary files */
1177 *tmp_filename
= '\0';
1179 /* If pname start with a back slash and not path information it means that
1180 the filename is valid for the current working directory. */
1182 else if (pname
[0] == '\\')
1184 strcpy (tmp_filename
, ".\\");
1185 strcat (tmp_filename
, pname
+1);
1188 strcpy (tmp_filename
, pname
);
1193 #elif defined (__linux__) || defined (__FreeBSD__) || defined (__NetBSD__) \
1194 || defined (__OpenBSD__) || defined (__GLIBC__) || defined (__ANDROID__) \
1195 || defined (__DragonFly__) || defined (__QNX__)
1196 #define MAX_SAFE_PATH 1000
1197 char *tmpdir
= getenv ("TMPDIR");
1199 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1200 a buffer overflow. */
1201 if (tmpdir
== NULL
|| strlen (tmpdir
) > MAX_SAFE_PATH
)
1203 strcpy (tmp_filename
, "/cache/gnat-XXXXXX");
1205 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
1208 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
1210 close (mkstemp(tmp_filename
));
1211 #elif defined (__vxworks) && !defined (VTHREADS)
1215 static ushort_t seed
= 0; /* used to generate unique name */
1217 /* Generate a unique name. */
1218 strcpy (tmp_filename
, "tmp");
1221 savepos
= pos
= tmp_filename
+ strlen (tmp_filename
) + index
;
1229 /* Fill up the name buffer from the last position. */
1231 for (t
= seed
; --index
>= 0; t
>>= 3)
1232 *--pos
= '0' + (t
& 07);
1234 /* Check to see if its unique, if not bump the seed and try again. */
1235 f
= fopen (tmp_filename
, "r");
1243 tmpnam (tmp_filename
);
1247 /* Open directory and returns a DIR pointer. */
1249 DIR* __gnat_opendir (char *name
)
1251 #if defined (__MINGW32__)
1252 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1254 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1255 return (DIR*)_topendir (wname
);
1258 return opendir (name
);
1262 /* Read the next entry in a directory. The returned string points somewhere
1265 #if defined (__sun__)
1266 /* For Solaris, be sure to use the 64-bit version, otherwise NFS reads may
1267 fail with EOVERFLOW if the server uses 64-bit cookies. */
1268 #define dirent dirent64
1269 #define readdir readdir64
1273 __gnat_readdir (DIR *dirp
, char *buffer
, int *len
)
1275 #if defined (__MINGW32__)
1276 struct _tdirent
*dirent
= _treaddir ((_TDIR
*)dirp
);
1280 WS2SC (buffer
, dirent
->d_name
, GNAT_MAX_PATH_LEN
);
1281 *len
= strlen (buffer
);
1288 #elif defined (HAVE_READDIR_R)
1289 /* If possible, try to use the thread-safe version. */
1290 if (readdir_r (dirp
, buffer
) != NULL
)
1292 *len
= strlen (((struct dirent
*) buffer
)->d_name
);
1293 return ((struct dirent
*) buffer
)->d_name
;
1299 struct dirent
*dirent
= (struct dirent
*) readdir (dirp
);
1303 strcpy (buffer
, dirent
->d_name
);
1304 *len
= strlen (buffer
);
1313 /* Close a directory entry. */
1315 int __gnat_closedir (DIR *dirp
)
1317 #if defined (__MINGW32__)
1318 return _tclosedir ((_TDIR
*)dirp
);
1321 return closedir (dirp
);
1325 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1328 __gnat_readdir_is_thread_safe (void)
1330 #ifdef HAVE_READDIR_R
1337 #if defined (_WIN32)
1338 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1339 static const unsigned long long w32_epoch_offset
= 11644473600ULL;
1341 /* Returns the file modification timestamp using Win32 routines which are
1342 immune against daylight saving time change. It is in fact not possible to
1343 use fstat for this purpose as the DST modify the st_mtime field of the
1347 win32_filetime (HANDLE h
)
1352 unsigned long long ull_time
;
1355 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1356 since <Jan 1st 1601>. This function must return the number of seconds
1357 since <Jan 1st 1970>. */
1359 if (GetFileTime (h
, NULL
, NULL
, &t_write
.ft_time
))
1360 return (time_t) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1364 /* As above but starting from a FILETIME. */
1366 f2t (const FILETIME
*ft
, __time64_t
*t
)
1371 unsigned long long ull_time
;
1374 t_write
.ft_time
= *ft
;
1375 *t
= (__time64_t
) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1379 /* Return a GNAT time stamp given a file name. */
1382 __gnat_file_time_name_attr (char* name
, struct file_attributes
* attr
)
1384 if (attr
->timestamp
== (OS_Time
)-2) {
1385 #if defined (_WIN32)
1387 WIN32_FILE_ATTRIBUTE_DATA fad
;
1388 __time64_t ret
= -1;
1389 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1390 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1392 if ((res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
)))
1393 f2t (&fad
.ftLastWriteTime
, &ret
);
1394 attr
->timestamp
= (OS_Time
) ret
;
1396 __gnat_stat_to_attr (-1, name
, attr
);
1399 return attr
->timestamp
;
1403 __gnat_file_time_name (char *name
)
1405 struct file_attributes attr
;
1406 __gnat_reset_attributes (&attr
);
1407 return __gnat_file_time_name_attr (name
, &attr
);
1410 /* Return a GNAT time stamp given a file descriptor. */
1413 __gnat_file_time_fd_attr (int fd
, struct file_attributes
* attr
)
1415 if (attr
->timestamp
== (OS_Time
)-2) {
1416 #if defined (_WIN32)
1417 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
1418 time_t ret
= win32_filetime (h
);
1419 attr
->timestamp
= (OS_Time
) ret
;
1422 __gnat_stat_to_attr (fd
, NULL
, attr
);
1426 return attr
->timestamp
;
1430 __gnat_file_time_fd (int fd
)
1432 struct file_attributes attr
;
1433 __gnat_reset_attributes (&attr
);
1434 return __gnat_file_time_fd_attr (fd
, &attr
);
1437 /* Set the file time stamp. */
1440 __gnat_set_file_time_name (char *name
, time_t time_stamp
)
1442 #if defined (__vxworks)
1444 /* Code to implement __gnat_set_file_time_name for these systems. */
1446 #elif defined (_WIN32)
1450 unsigned long long ull_time
;
1452 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1454 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1456 HANDLE h
= CreateFile
1457 (wname
, GENERIC_WRITE
, FILE_SHARE_WRITE
, NULL
,
1458 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
,
1460 if (h
== INVALID_HANDLE_VALUE
)
1462 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1463 t_write
.ull_time
= ((unsigned long long)time_stamp
+ w32_epoch_offset
);
1464 /* Convert to 100 nanosecond units */
1465 t_write
.ull_time
*= 10000000ULL;
1467 SetFileTime(h
, NULL
, NULL
, &t_write
.ft_time
);
1472 struct utimbuf utimbuf
;
1475 /* Set modification time to requested time. */
1476 utimbuf
.modtime
= time_stamp
;
1478 /* Set access time to now in local time. */
1480 utimbuf
.actime
= mktime (localtime (&t
));
1482 utime (name
, &utimbuf
);
1486 /* Get the list of installed standard libraries from the
1487 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1491 __gnat_get_libraries_from_registry (void)
1493 char *result
= (char *) xmalloc (1);
1497 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
1500 DWORD name_size
, value_size
;
1507 /* First open the key. */
1508 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1510 if (res
== ERROR_SUCCESS
)
1511 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1512 KEY_READ
, ®_key
);
1514 if (res
== ERROR_SUCCESS
)
1515 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1517 if (res
== ERROR_SUCCESS
)
1518 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1520 /* If the key exists, read out all the values in it and concatenate them
1522 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1524 value_size
= name_size
= 256;
1525 res
= RegEnumValueA (reg_key
, index
, name
, &name_size
, 0,
1526 &type
, (LPBYTE
)value
, &value_size
);
1528 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1530 char *old_result
= result
;
1532 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1533 strcpy (result
, old_result
);
1534 strcat (result
, value
);
1535 strcat (result
, ";");
1540 /* Remove the trailing ";". */
1542 result
[strlen (result
) - 1] = 0;
1548 /* Query information for the given file NAME and return it in STATBUF.
1549 * Returns 0 for success, or errno value for failure.
1552 __gnat_stat (char *name
, GNAT_STRUCT_STAT
*statbuf
)
1555 WIN32_FILE_ATTRIBUTE_DATA fad
;
1556 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1561 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1562 name_len
= _tcslen (wname
);
1564 if (name_len
> GNAT_MAX_PATH_LEN
)
1567 ZeroMemory (statbuf
, sizeof(GNAT_STRUCT_STAT
));
1569 res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
);
1572 error
= GetLastError();
1574 /* Check file existence using GetFileAttributes() which does not fail on
1575 special Windows files like con:, aux:, nul: etc... */
1577 if (GetFileAttributes(wname
) != INVALID_FILE_ATTRIBUTES
) {
1578 /* Just pretend that it is a regular and readable file */
1579 statbuf
->st_mode
= S_IFREG
| S_IREAD
| S_IWRITE
;
1584 case ERROR_ACCESS_DENIED
:
1585 case ERROR_SHARING_VIOLATION
:
1586 case ERROR_LOCK_VIOLATION
:
1587 case ERROR_SHARING_BUFFER_EXCEEDED
:
1589 case ERROR_BUFFER_OVERFLOW
:
1590 return ENAMETOOLONG
;
1591 case ERROR_NOT_ENOUGH_MEMORY
:
1598 f2t (&fad
.ftCreationTime
, &statbuf
->st_ctime
);
1599 f2t (&fad
.ftLastWriteTime
, &statbuf
->st_mtime
);
1600 f2t (&fad
.ftLastAccessTime
, &statbuf
->st_atime
);
1603 (__int64
)fad
.nFileSizeLow
| (__int64
)fad
.nFileSizeHigh
<< 32;
1605 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1606 statbuf
->st_mode
= S_IREAD
;
1608 if (fad
.dwFileAttributes
& FILE_ATTRIBUTE_DIRECTORY
)
1609 statbuf
->st_mode
|= S_IFDIR
;
1611 statbuf
->st_mode
|= S_IFREG
;
1613 if (!(fad
.dwFileAttributes
& FILE_ATTRIBUTE_READONLY
))
1614 statbuf
->st_mode
|= S_IWRITE
;
1619 return GNAT_STAT (name
, statbuf
) == 0 ? 0 : errno
;
1623 /*************************************************************************
1624 ** Check whether a file exists
1625 *************************************************************************/
1628 __gnat_file_exists_attr (char* name
, struct file_attributes
* attr
)
1630 if (attr
->exists
== ATTR_UNSET
)
1631 __gnat_stat_to_attr (-1, name
, attr
);
1633 return attr
->exists
;
1637 __gnat_file_exists (char *name
)
1639 struct file_attributes attr
;
1640 __gnat_reset_attributes (&attr
);
1641 return __gnat_file_exists_attr (name
, &attr
);
1644 /**********************************************************************
1645 ** Whether name is an absolute path
1646 **********************************************************************/
1649 __gnat_is_absolute_path (char *name
, int length
)
1652 /* On VxWorks systems, an absolute path can be represented (depending on
1653 the host platform) as either /dir/file, or device:/dir/file, or
1654 device:drive_letter:/dir/file. */
1661 for (index
= 0; index
< length
; index
++)
1663 if (name
[index
] == ':' &&
1664 ((name
[index
+ 1] == '/') ||
1665 (isalpha (name
[index
+ 1]) && index
+ 2 <= length
&&
1666 name
[index
+ 2] == '/')))
1669 else if (name
[index
] == '/')
1674 return (length
!= 0) &&
1675 (*name
== '/' || *name
== DIR_SEPARATOR
1676 #if defined (WINNT) || defined(__DJGPP__)
1677 || (length
> 1 && ISALPHA (name
[0]) && name
[1] == ':')
1684 __gnat_is_regular_file_attr (char* name
, struct file_attributes
* attr
)
1686 if (attr
->regular
== ATTR_UNSET
)
1687 __gnat_stat_to_attr (-1, name
, attr
);
1689 return attr
->regular
;
1693 __gnat_is_regular_file (char *name
)
1695 struct file_attributes attr
;
1697 __gnat_reset_attributes (&attr
);
1698 return __gnat_is_regular_file_attr (name
, &attr
);
1702 __gnat_is_regular_file_fd (int fd
)
1705 GNAT_STRUCT_STAT statbuf
;
1707 ret
= GNAT_FSTAT (fd
, &statbuf
);
1708 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1712 __gnat_is_directory_attr (char* name
, struct file_attributes
* attr
)
1714 if (attr
->directory
== ATTR_UNSET
)
1715 __gnat_stat_to_attr (-1, name
, attr
);
1717 return attr
->directory
;
1721 __gnat_is_directory (char *name
)
1723 struct file_attributes attr
;
1725 __gnat_reset_attributes (&attr
);
1726 return __gnat_is_directory_attr (name
, &attr
);
1729 #if defined (_WIN32)
1731 /* Returns the same constant as GetDriveType but takes a pathname as
1735 GetDriveTypeFromPath (TCHAR
*wfullpath
)
1737 TCHAR wdrv
[MAX_PATH
];
1738 TCHAR wpath
[MAX_PATH
];
1739 TCHAR wfilename
[MAX_PATH
];
1740 TCHAR wext
[MAX_PATH
];
1742 _tsplitpath (wfullpath
, wdrv
, wpath
, wfilename
, wext
);
1744 if (_tcslen (wdrv
) != 0)
1746 /* we have a drive specified. */
1747 _tcscat (wdrv
, _T("\\"));
1748 return GetDriveType (wdrv
);
1752 /* No drive specified. */
1754 /* Is this a relative path, if so get current drive type. */
1755 if (wpath
[0] != _T('\\') ||
1756 (_tcslen (wpath
) > 2 && wpath
[0] == _T('\\')
1757 && wpath
[1] != _T('\\')))
1758 return GetDriveType (NULL
);
1760 UINT result
= GetDriveType (wpath
);
1762 /* Cannot guess the drive type, is this \\.\ ? */
1764 if (result
== DRIVE_NO_ROOT_DIR
&&
1765 _tcslen (wpath
) >= 4 && wpath
[0] == _T('\\') && wpath
[1] == _T('\\')
1766 && wpath
[2] == _T('.') && wpath
[3] == _T('\\'))
1768 if (_tcslen (wpath
) == 4)
1769 _tcscat (wpath
, wfilename
);
1771 LPTSTR p
= &wpath
[4];
1772 LPTSTR b
= _tcschr (p
, _T('\\'));
1776 /* logical drive \\.\c\dir\file */
1782 _tcscat (p
, _T(":\\"));
1784 return GetDriveType (p
);
1791 /* This MingW section contains code to work with ACL. */
1793 __gnat_check_OWNER_ACL (TCHAR
*wname
,
1794 DWORD CheckAccessDesired
,
1795 GENERIC_MAPPING CheckGenericMapping
)
1797 DWORD dwAccessDesired
, dwAccessAllowed
;
1798 PRIVILEGE_SET PrivilegeSet
;
1799 DWORD dwPrivSetSize
= sizeof (PRIVILEGE_SET
);
1800 BOOL fAccessGranted
= FALSE
;
1801 HANDLE hToken
= NULL
;
1803 PSECURITY_DESCRIPTOR pSD
= NULL
;
1806 (wname
, OWNER_SECURITY_INFORMATION
|
1807 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1810 if ((pSD
= (SECURITY_DESCRIPTOR
*) HeapAlloc
1811 (GetProcessHeap (), HEAP_ZERO_MEMORY
, nLength
)) == NULL
)
1814 /* Obtain the security descriptor. */
1816 if (!GetFileSecurity
1817 (wname
, OWNER_SECURITY_INFORMATION
|
1818 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1819 pSD
, nLength
, &nLength
))
1822 if (!ImpersonateSelf (SecurityImpersonation
))
1825 if (!OpenThreadToken
1826 (GetCurrentThread(), TOKEN_DUPLICATE
| TOKEN_QUERY
, FALSE
, &hToken
))
1829 /* Undoes the effect of ImpersonateSelf. */
1833 /* We want to test for write permissions. */
1835 dwAccessDesired
= CheckAccessDesired
;
1837 MapGenericMask (&dwAccessDesired
, &CheckGenericMapping
);
1840 (pSD
, /* security descriptor to check */
1841 hToken
, /* impersonation token */
1842 dwAccessDesired
, /* requested access rights */
1843 &CheckGenericMapping
, /* pointer to GENERIC_MAPPING */
1844 &PrivilegeSet
, /* receives privileges used in check */
1845 &dwPrivSetSize
, /* size of PrivilegeSet buffer */
1846 &dwAccessAllowed
, /* receives mask of allowed access rights */
1850 CloseHandle (hToken
);
1851 HeapFree (GetProcessHeap (), 0, pSD
);
1852 return fAccessGranted
;
1856 CloseHandle (hToken
);
1857 HeapFree (GetProcessHeap (), 0, pSD
);
1862 __gnat_set_OWNER_ACL (TCHAR
*wname
,
1863 ACCESS_MODE AccessMode
,
1864 DWORD AccessPermissions
)
1866 PACL pOldDACL
= NULL
;
1867 PACL pNewDACL
= NULL
;
1868 PSECURITY_DESCRIPTOR pSD
= NULL
;
1870 TCHAR username
[100];
1873 /* Get current user, he will act as the owner */
1875 if (!GetUserName (username
, &unsize
))
1878 if (GetNamedSecurityInfo
1881 DACL_SECURITY_INFORMATION
,
1882 NULL
, NULL
, &pOldDACL
, NULL
, &pSD
) != ERROR_SUCCESS
)
1885 BuildExplicitAccessWithName
1886 (&ea
, username
, AccessPermissions
, (ACCESS_MODE
) AccessMode
, NO_INHERITANCE
);
1888 if (AccessMode
== SET_ACCESS
)
1890 /* SET_ACCESS, we want to set an explicte set of permissions, do not
1891 merge with current DACL. */
1892 if (SetEntriesInAcl (1, &ea
, NULL
, &pNewDACL
) != ERROR_SUCCESS
)
1896 if (SetEntriesInAcl (1, &ea
, pOldDACL
, &pNewDACL
) != ERROR_SUCCESS
)
1899 if (SetNamedSecurityInfo
1900 (wname
, SE_FILE_OBJECT
,
1901 DACL_SECURITY_INFORMATION
, NULL
, NULL
, pNewDACL
, NULL
) != ERROR_SUCCESS
)
1905 LocalFree (pNewDACL
);
1908 /* Check if it is possible to use ACL for wname, the file must not be on a
1912 __gnat_can_use_acl (TCHAR
*wname
)
1914 return __gnat_use_acl
&& GetDriveTypeFromPath (wname
) != DRIVE_REMOTE
;
1917 #endif /* defined (_WIN32) */
1920 __gnat_is_readable_file_attr (char* name
, struct file_attributes
* attr
)
1922 if (attr
->readable
== ATTR_UNSET
)
1924 #if defined (_WIN32)
1925 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1926 GENERIC_MAPPING GenericMapping
;
1928 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1930 if (__gnat_can_use_acl (wname
))
1932 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1933 GenericMapping
.GenericRead
= GENERIC_READ
;
1935 __gnat_check_OWNER_ACL (wname
, FILE_READ_DATA
, GenericMapping
);
1938 attr
->readable
= GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
;
1940 __gnat_stat_to_attr (-1, name
, attr
);
1944 return attr
->readable
;
1948 __gnat_is_read_accessible_file (char *name
)
1950 #if defined (_WIN32)
1951 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1953 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1955 return !_waccess (wname
, 4);
1957 #elif defined (__vxworks)
1960 if ((fd
= open (name
, O_RDONLY
, 0)) < 0)
1966 return !access (name
, R_OK
);
1971 __gnat_is_readable_file (char *name
)
1973 struct file_attributes attr
;
1975 __gnat_reset_attributes (&attr
);
1976 return __gnat_is_readable_file_attr (name
, &attr
);
1980 __gnat_is_writable_file_attr (char* name
, struct file_attributes
* attr
)
1982 if (attr
->writable
== ATTR_UNSET
)
1984 #if defined (_WIN32)
1985 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1986 GENERIC_MAPPING GenericMapping
;
1988 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1990 if (__gnat_can_use_acl (wname
))
1992 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1993 GenericMapping
.GenericWrite
= GENERIC_WRITE
;
1995 attr
->writable
= __gnat_check_OWNER_ACL
1996 (wname
, FILE_WRITE_DATA
| FILE_APPEND_DATA
, GenericMapping
)
1997 && !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
2001 !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
2004 __gnat_stat_to_attr (-1, name
, attr
);
2008 return attr
->writable
;
2012 __gnat_is_writable_file (char *name
)
2014 struct file_attributes attr
;
2016 __gnat_reset_attributes (&attr
);
2017 return __gnat_is_writable_file_attr (name
, &attr
);
2021 __gnat_is_write_accessible_file (char *name
)
2023 #if defined (_WIN32)
2024 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2026 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2028 return !_waccess (wname
, 2);
2030 #elif defined (__vxworks)
2033 if ((fd
= open (name
, O_WRONLY
, 0)) < 0)
2039 return !access (name
, W_OK
);
2044 __gnat_is_executable_file_attr (char* name
, struct file_attributes
* attr
)
2046 if (attr
->executable
== ATTR_UNSET
)
2048 #if defined (_WIN32)
2049 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2050 GENERIC_MAPPING GenericMapping
;
2052 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2054 if (__gnat_can_use_acl (wname
))
2056 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2057 GenericMapping
.GenericExecute
= GENERIC_EXECUTE
;
2060 __gnat_check_OWNER_ACL (wname
, FILE_EXECUTE
, GenericMapping
);
2064 TCHAR
*l
, *last
= _tcsstr(wname
, _T(".exe"));
2066 /* look for last .exe */
2068 while ((l
= _tcsstr(last
+1, _T(".exe"))))
2072 GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
2073 && (last
- wname
) == (int) (_tcslen (wname
) - 4);
2076 __gnat_stat_to_attr (-1, name
, attr
);
2080 return attr
->regular
&& attr
->executable
;
2084 __gnat_is_executable_file (char *name
)
2086 struct file_attributes attr
;
2088 __gnat_reset_attributes (&attr
);
2089 return __gnat_is_executable_file_attr (name
, &attr
);
2093 __gnat_set_writable (char *name
)
2095 #if defined (_WIN32)
2096 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2098 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2100 if (__gnat_can_use_acl (wname
))
2101 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_WRITE
);
2104 (wname
, GetFileAttributes (wname
) & ~FILE_ATTRIBUTE_READONLY
);
2105 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2106 GNAT_STRUCT_STAT statbuf
;
2108 if (GNAT_STAT (name
, &statbuf
) == 0)
2110 statbuf
.st_mode
= statbuf
.st_mode
| S_IWUSR
;
2111 chmod (name
, statbuf
.st_mode
);
2116 /* must match definition in s-os_lib.ads */
2122 __gnat_set_executable (char *name
, int mode ATTRIBUTE_UNUSED
)
2124 #if defined (_WIN32)
2125 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2127 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2129 if (__gnat_can_use_acl (wname
))
2130 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_EXECUTE
);
2132 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2133 GNAT_STRUCT_STAT statbuf
;
2135 if (GNAT_STAT (name
, &statbuf
) == 0)
2138 statbuf
.st_mode
= statbuf
.st_mode
| S_IXUSR
;
2140 statbuf
.st_mode
= statbuf
.st_mode
| S_IXGRP
;
2141 if (mode
& S_OTHERS
)
2142 statbuf
.st_mode
= statbuf
.st_mode
| S_IXOTH
;
2143 chmod (name
, statbuf
.st_mode
);
2149 __gnat_set_non_writable (char *name
)
2151 #if defined (_WIN32)
2152 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2154 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2156 if (__gnat_can_use_acl (wname
))
2157 __gnat_set_OWNER_ACL
2158 (wname
, DENY_ACCESS
,
2159 FILE_WRITE_DATA
| FILE_APPEND_DATA
|
2160 FILE_WRITE_EA
| FILE_WRITE_ATTRIBUTES
);
2163 (wname
, GetFileAttributes (wname
) | FILE_ATTRIBUTE_READONLY
);
2164 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2165 GNAT_STRUCT_STAT statbuf
;
2167 if (GNAT_STAT (name
, &statbuf
) == 0)
2169 statbuf
.st_mode
= statbuf
.st_mode
& 07577;
2170 chmod (name
, statbuf
.st_mode
);
2176 __gnat_set_readable (char *name
)
2178 #if defined (_WIN32)
2179 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2181 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2183 if (__gnat_can_use_acl (wname
))
2184 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_READ
);
2186 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2187 GNAT_STRUCT_STAT statbuf
;
2189 if (GNAT_STAT (name
, &statbuf
) == 0)
2191 chmod (name
, statbuf
.st_mode
| S_IREAD
);
2197 __gnat_set_non_readable (char *name
)
2199 #if defined (_WIN32)
2200 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2202 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2204 if (__gnat_can_use_acl (wname
))
2205 __gnat_set_OWNER_ACL (wname
, DENY_ACCESS
, FILE_GENERIC_READ
);
2207 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2208 GNAT_STRUCT_STAT statbuf
;
2210 if (GNAT_STAT (name
, &statbuf
) == 0)
2212 chmod (name
, statbuf
.st_mode
& (~S_IREAD
));
2218 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED
,
2219 struct file_attributes
* attr
)
2221 if (attr
->symbolic_link
== ATTR_UNSET
)
2223 #if defined (__vxworks)
2224 attr
->symbolic_link
= 0;
2226 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2228 GNAT_STRUCT_STAT statbuf
;
2229 ret
= GNAT_LSTAT (name
, &statbuf
);
2230 attr
->symbolic_link
= (!ret
&& S_ISLNK (statbuf
.st_mode
));
2232 attr
->symbolic_link
= 0;
2235 return attr
->symbolic_link
;
2239 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED
)
2241 struct file_attributes attr
;
2243 __gnat_reset_attributes (&attr
);
2244 return __gnat_is_symbolic_link_attr (name
, &attr
);
2247 #if defined (__sun__)
2248 /* Using fork on Solaris will duplicate all the threads. fork1, which
2249 duplicates only the active thread, must be used instead, or spawning
2250 subprocess from a program with tasking will lead into numerous problems. */
2255 __gnat_portable_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2257 int status ATTRIBUTE_UNUSED
= 0;
2258 int finished ATTRIBUTE_UNUSED
;
2259 int pid ATTRIBUTE_UNUSED
;
2261 #if defined (__vxworks) || defined(__PikeOS__)
2264 #elif defined (__DJGPP__) || defined (_WIN32)
2265 /* args[0] must be quotes as it could contain a full pathname with spaces */
2266 char *args_0
= args
[0];
2267 args
[0] = (char *)xmalloc (strlen (args_0
) + 3);
2268 strcpy (args
[0], "\"");
2269 strcat (args
[0], args_0
);
2270 strcat (args
[0], "\"");
2272 status
= spawnvp (P_WAIT
, args_0
, (char ** const)args
);
2274 /* restore previous value */
2276 args
[0] = (char *)args_0
;
2292 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2297 finished
= waitpid (pid
, &status
, 0);
2299 if (finished
!= pid
|| WIFEXITED (status
) == 0)
2302 return WEXITSTATUS (status
);
2308 /* Create a copy of the given file descriptor.
2309 Return -1 if an error occurred. */
2312 __gnat_dup (int oldfd
)
2314 #if defined (__vxworks) && !defined (__RTP__)
2315 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2323 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2324 Return -1 if an error occurred. */
2327 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED
, int newfd ATTRIBUTE_UNUSED
)
2329 #if defined (__vxworks) && !defined (__RTP__)
2330 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2333 #elif defined (__PikeOS__)
2334 /* Not supported. */
2336 #elif defined (_WIN32)
2337 /* Special case when oldfd and newfd are identical and are the standard
2338 input, output or error as this makes Windows XP hangs. Note that we
2339 do that only for standard file descriptors that are known to be valid. */
2340 if (oldfd
== newfd
&& newfd
>= 0 && newfd
<= 2)
2343 return dup2 (oldfd
, newfd
);
2345 return dup2 (oldfd
, newfd
);
2350 __gnat_number_of_cpus (void)
2354 #if defined (__linux__) || defined (__sun__) || defined (_AIX) \
2355 || defined (__APPLE__) || defined (__FreeBSD__) || defined (__OpenBSD__) \
2356 || defined (__DragonFly__) || defined (__NetBSD__)
2357 cores
= (int) sysconf (_SC_NPROCESSORS_ONLN
);
2359 #elif defined (__QNX__)
2360 cores
= (int) _syspage_ptr
->num_cpu
;
2362 #elif defined (__hpux__)
2363 struct pst_dynamic psd
;
2364 if (pstat_getdynamic (&psd
, sizeof (psd
), 1, 0) != -1)
2365 cores
= (int) psd
.psd_proc_cnt
;
2367 #elif defined (_WIN32)
2368 SYSTEM_INFO sysinfo
;
2369 GetSystemInfo (&sysinfo
);
2370 cores
= (int) sysinfo
.dwNumberOfProcessors
;
2372 #elif defined (_WRS_CONFIG_SMP)
2373 unsigned int vxCpuConfiguredGet (void);
2375 cores
= vxCpuConfiguredGet ();
2382 /* WIN32 code to implement a wait call that wait for any child process. */
2384 #if defined (_WIN32)
2386 /* Synchronization code, to be thread safe. */
2390 /* For the Cert run times on native Windows we use dummy functions
2391 for locking and unlocking tasks since we do not support multiple
2392 threads on this configuration (Cert run time on native Windows). */
2394 static void EnterCS (void) {}
2395 static void LeaveCS (void) {}
2396 static void SignalListChanged (void) {}
2400 CRITICAL_SECTION ProcListCS
;
2401 HANDLE ProcListEvt
= NULL
;
2403 static void EnterCS (void)
2405 EnterCriticalSection(&ProcListCS
);
2408 static void LeaveCS (void)
2410 LeaveCriticalSection(&ProcListCS
);
2413 static void SignalListChanged (void)
2415 SetEvent (ProcListEvt
);
2420 static HANDLE
*HANDLES_LIST
= NULL
;
2421 static int *PID_LIST
= NULL
, plist_length
= 0, plist_max_length
= 0;
2424 add_handle (HANDLE h
, int pid
)
2426 /* -------------------- critical section -------------------- */
2429 if (plist_length
== plist_max_length
)
2431 plist_max_length
+= 100;
2433 (HANDLE
*) xrealloc (HANDLES_LIST
, sizeof (HANDLE
) * plist_max_length
);
2435 (int *) xrealloc (PID_LIST
, sizeof (int) * plist_max_length
);
2438 HANDLES_LIST
[plist_length
] = h
;
2439 PID_LIST
[plist_length
] = pid
;
2442 SignalListChanged();
2444 /* -------------------- critical section -------------------- */
2448 __gnat_win32_remove_handle (HANDLE h
, int pid
)
2453 /* -------------------- critical section -------------------- */
2456 for (j
= 0; j
< plist_length
; j
++)
2458 if ((HANDLES_LIST
[j
] == h
) || (PID_LIST
[j
] == pid
))
2462 HANDLES_LIST
[j
] = HANDLES_LIST
[plist_length
];
2463 PID_LIST
[j
] = PID_LIST
[plist_length
];
2470 /* -------------------- critical section -------------------- */
2473 SignalListChanged();
2479 win32_no_block_spawn (char *command
, char *args
[], HANDLE
*h
, int *pid
)
2483 PROCESS_INFORMATION PI
;
2484 SECURITY_ATTRIBUTES SA
;
2489 /* compute the total command line length */
2493 csize
+= strlen (args
[k
]) + 1;
2497 full_command
= (char *) xmalloc (csize
);
2500 SI
.cb
= sizeof (STARTUPINFO
);
2501 SI
.lpReserved
= NULL
;
2502 SI
.lpReserved2
= NULL
;
2503 SI
.lpDesktop
= NULL
;
2507 SI
.wShowWindow
= SW_HIDE
;
2509 /* Security attributes. */
2510 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
2511 SA
.bInheritHandle
= TRUE
;
2512 SA
.lpSecurityDescriptor
= NULL
;
2514 /* Prepare the command string. */
2515 strcpy (full_command
, command
);
2516 strcat (full_command
, " ");
2521 strcat (full_command
, args
[k
]);
2522 strcat (full_command
, " ");
2527 int wsize
= csize
* 2;
2528 TCHAR
*wcommand
= (TCHAR
*) xmalloc (wsize
);
2530 S2WSC (wcommand
, full_command
, wsize
);
2532 free (full_command
);
2534 result
= CreateProcess
2535 (NULL
, wcommand
, &SA
, NULL
, TRUE
,
2536 GetPriorityClass (GetCurrentProcess()), NULL
, NULL
, &SI
, &PI
);
2543 CloseHandle (PI
.hThread
);
2545 *pid
= PI
.dwProcessId
;
2555 win32_wait (int *status
)
2557 DWORD exitcode
, pid
;
2568 if (plist_length
== 0)
2574 /* -------------------- critical section -------------------- */
2577 /* ??? We can't wait for more than MAXIMUM_WAIT_OBJECTS due to a Win32
2579 if (plist_length
< MAXIMUM_WAIT_OBJECTS
)
2580 hl_len
= plist_length
;
2588 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
);
2589 memmove (hl
, HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2590 pidl
= (int *) xmalloc (sizeof (int) * hl_len
);
2591 memmove (pidl
, PID_LIST
, sizeof (int) * hl_len
);
2593 /* Note that index 0 contains the event handle that is signaled when the
2594 process list has changed */
2595 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * (hl_len
+ 1));
2596 hl
[0] = ProcListEvt
;
2597 memmove (&hl
[1], HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2598 pidl
= (int *) xmalloc (sizeof (int) * (hl_len
+ 1));
2599 memmove (&pidl
[1], PID_LIST
, sizeof (int) * hl_len
);
2604 /* -------------------- critical section -------------------- */
2606 res
= WaitForMultipleObjects (hl_len
, hl
, FALSE
, INFINITE
);
2608 /* If there was an error, exit now */
2609 if (res
== WAIT_FAILED
)
2617 /* if the ProcListEvt has been signaled then the list of processes has been
2618 updated to add or remove a handle, just loop over */
2620 if (res
- WAIT_OBJECT_0
== 0)
2627 /* Handle two distinct groups of return codes: finished waits and abandoned
2630 if (res
< WAIT_ABANDONED_0
)
2631 pos
= res
- WAIT_OBJECT_0
;
2633 pos
= res
- WAIT_ABANDONED_0
;
2636 GetExitCodeProcess (h
, &exitcode
);
2639 found
= __gnat_win32_remove_handle (h
, -1);
2644 /* if not found another process waiting has already handled this process */
2651 *status
= (int) exitcode
;
2658 __gnat_portable_no_block_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2661 #if defined (__vxworks) || defined (__PikeOS__)
2662 /* Not supported. */
2665 #elif defined(__DJGPP__)
2666 if (spawnvp (P_WAIT
, args
[0], args
) != 0)
2671 #elif defined (_WIN32)
2676 win32_no_block_spawn (args
[0], args
, &h
, &pid
);
2679 add_handle (h
, pid
);
2692 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2702 __gnat_portable_wait (int *process_status
)
2707 #if defined (__vxworks) || defined (__PikeOS__)
2708 /* Not sure what to do here, so do nothing but return zero. */
2710 #elif defined (_WIN32)
2712 pid
= win32_wait (&status
);
2714 #elif defined (__DJGPP__)
2715 /* Child process has already ended in case of DJGPP.
2716 No need to do anything. Just return success. */
2719 pid
= waitpid (-1, &status
, 0);
2720 status
= status
& 0xffff;
2723 *process_status
= status
;
2728 __gnat_portable_no_block_wait (int *process_status
)
2733 #if defined (__vxworks) || defined (__PikeOS__) || defined (_WIN32)
2734 /* Not supported. */
2739 pid
= waitpid (-1, &status
, WNOHANG
);
2740 status
= status
& 0xffff;
2743 *process_status
= status
;
2748 __gnat_os_exit (int status
)
2754 __gnat_current_process_id (void)
2756 #if defined (__vxworks) || defined (__PikeOS__)
2759 #elif defined (_WIN32)
2761 return (int)GetCurrentProcessId();
2765 return (int)getpid();
2769 /* Locate file on path, that matches a predicate */
2772 __gnat_locate_file_with_predicate (char *file_name
, char *path_val
,
2773 int (*predicate
)(char *))
2776 char *file_path
= (char *) alloca (strlen (file_name
) + 1);
2779 /* Return immediately if file_name is empty */
2781 if (*file_name
== '\0')
2784 /* Remove quotes around file_name if present */
2790 strcpy (file_path
, ptr
);
2792 ptr
= file_path
+ strlen (file_path
) - 1;
2797 /* Handle absolute pathnames. */
2799 absolute
= __gnat_is_absolute_path (file_path
, strlen (file_name
));
2803 if (predicate (file_path
))
2804 return xstrdup (file_path
);
2809 /* If file_name include directory separator(s), try it first as
2810 a path name relative to the current directory */
2811 for (ptr
= file_name
; *ptr
&& *ptr
!= '/' && *ptr
!= DIR_SEPARATOR
; ptr
++)
2816 if (predicate (file_name
))
2817 return xstrdup (file_name
);
2824 /* The result has to be smaller than path_val + file_name. */
2826 (char *) alloca (strlen (path_val
) + strlen (file_name
) + 2);
2830 /* Skip the starting quote */
2832 if (*path_val
== '"')
2835 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
2836 *ptr
++ = *path_val
++;
2838 /* If directory is empty, it is the current directory*/
2840 if (ptr
== file_path
)
2847 /* Skip the ending quote */
2852 if (*ptr
!= '/' && *ptr
!= DIR_SEPARATOR
)
2853 *++ptr
= DIR_SEPARATOR
;
2855 strcpy (++ptr
, file_name
);
2857 if (predicate (file_path
))
2858 return xstrdup (file_path
);
2863 /* Skip path separator */
2872 /* Locate an executable file, give a Path value. */
2875 __gnat_locate_executable_file (char *file_name
, char *path_val
)
2877 return __gnat_locate_file_with_predicate
2878 (file_name
, path_val
, &__gnat_is_executable_file
);
2881 /* Locate a regular file, give a Path value. */
2884 __gnat_locate_regular_file (char *file_name
, char *path_val
)
2886 return __gnat_locate_file_with_predicate
2887 (file_name
, path_val
, &__gnat_is_regular_file
);
2890 /* Locate an executable given a Path argument. This routine is only used by
2891 gnatbl and should not be used otherwise. Use locate_exec_on_path
2895 __gnat_locate_exec (char *exec_name
, char *path_val
)
2897 const unsigned int len
= strlen (HOST_EXECUTABLE_SUFFIX
);
2900 if (len
> 0 && !strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
2902 char *full_exec_name
= (char *) alloca (strlen (exec_name
) + len
+ 1);
2904 strcpy (full_exec_name
, exec_name
);
2905 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
2906 ptr
= __gnat_locate_executable_file (full_exec_name
, path_val
);
2909 return __gnat_locate_executable_file (exec_name
, path_val
);
2913 return __gnat_locate_executable_file (exec_name
, path_val
);
2916 /* Locate an executable using the Systems default PATH. */
2919 __gnat_locate_exec_on_path (char *exec_name
)
2923 #if defined (_WIN32)
2924 TCHAR
*wpath_val
= _tgetenv (_T("PATH"));
2926 /* In Win32 systems we expand the PATH as for XP environment
2927 variables are not automatically expanded. We also prepend the
2928 ".;" to the path to match normal NT path search semantics */
2930 #define EXPAND_BUFFER_SIZE 32767
2932 wapath_val
= (TCHAR
*) alloca (EXPAND_BUFFER_SIZE
);
2934 wapath_val
[0] = '.';
2935 wapath_val
[1] = ';';
2937 DWORD res
= ExpandEnvironmentStrings
2938 (wpath_val
, &wapath_val
[2], EXPAND_BUFFER_SIZE
- 2);
2940 if (!res
) wapath_val
[0] = _T('\0');
2942 apath_val
= (char *) alloca (EXPAND_BUFFER_SIZE
);
2944 WS2SC (apath_val
, wapath_val
, EXPAND_BUFFER_SIZE
);
2947 const char *path_val
= getenv ("PATH");
2949 /* If PATH is not defined, proceed with __gnat_locate_exec anyway, so we can
2950 find files that contain directory names. */
2952 if (path_val
== NULL
) path_val
= "";
2953 apath_val
= (char *) alloca (strlen (path_val
) + 1);
2954 strcpy (apath_val
, path_val
);
2957 return __gnat_locate_exec (exec_name
, apath_val
);
2960 /* Dummy functions for Osint import for non-VMS systems.
2961 ??? To be removed. */
2964 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED
,
2965 int onlydirs ATTRIBUTE_UNUSED
)
2971 __gnat_to_canonical_file_list_next (void)
2973 static char empty
[] = "";
2978 __gnat_to_canonical_file_list_free (void)
2983 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2989 __gnat_to_canonical_file_spec (char *filespec
)
2995 __gnat_to_canonical_path_spec (char *pathspec
)
3001 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
3007 __gnat_to_host_file_spec (char *filespec
)
3013 __gnat_adjust_os_resource_limits (void)
3017 #if defined (__mips_vxworks)
3021 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
3025 #if defined (_WIN32)
3026 int __gnat_argument_needs_quote
= 1;
3028 int __gnat_argument_needs_quote
= 0;
3031 /* This option is used to enable/disable object files handling from the
3032 binder file by the GNAT Project module. For example, this is disabled on
3033 Windows (prior to GCC 3.4) as it is already done by the mdll module.
3034 Stating with GCC 3.4 the shared libraries are not based on mdll
3035 anymore as it uses the GCC's -shared option */
3036 #if defined (_WIN32) \
3037 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
3038 int __gnat_prj_add_obj_files
= 0;
3040 int __gnat_prj_add_obj_files
= 1;
3043 /* char used as prefix/suffix for environment variables */
3044 #if defined (_WIN32)
3045 char __gnat_environment_char
= '%';
3047 char __gnat_environment_char
= '$';
3050 /* This functions copy the file attributes from a source file to a
3053 mode = 0 : In this mode copy only the file time stamps (last access and
3054 last modification time stamps).
3056 mode = 1 : In this mode, time stamps and read/write/execute attributes are
3059 mode = 2 : In this mode, only read/write/execute attributes are copied
3061 Returns 0 if operation was successful and -1 in case of error. */
3064 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED
, char *to ATTRIBUTE_UNUSED
,
3065 int mode ATTRIBUTE_UNUSED
)
3067 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
3070 #elif defined (_WIN32)
3071 TCHAR wfrom
[GNAT_MAX_PATH_LEN
+ 2];
3072 TCHAR wto
[GNAT_MAX_PATH_LEN
+ 2];
3074 FILETIME fct
, flat
, flwt
;
3077 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
+ 2);
3078 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
+ 2);
3080 /* Do we need to copy the timestamp ? */
3083 /* retrieve from times */
3086 (wfrom
, GENERIC_READ
, 0, NULL
, OPEN_EXISTING
,
3087 FILE_ATTRIBUTE_NORMAL
, NULL
);
3089 if (hfrom
== INVALID_HANDLE_VALUE
)
3092 res
= GetFileTime (hfrom
, &fct
, &flat
, &flwt
);
3094 CloseHandle (hfrom
);
3099 /* retrieve from times */
3102 (wto
, GENERIC_WRITE
, 0, NULL
, OPEN_EXISTING
,
3103 FILE_ATTRIBUTE_NORMAL
, NULL
);
3105 if (hto
== INVALID_HANDLE_VALUE
)
3108 res
= SetFileTime (hto
, NULL
, &flat
, &flwt
);
3116 /* Do we need to copy the permissions ? */
3117 /* Set file attributes in full mode. */
3121 DWORD attribs
= GetFileAttributes (wfrom
);
3123 if (attribs
== INVALID_FILE_ATTRIBUTES
)
3126 res
= SetFileAttributes (wto
, attribs
);
3134 GNAT_STRUCT_STAT fbuf
;
3135 struct utimbuf tbuf
;
3137 if (GNAT_STAT (from
, &fbuf
) == -1) {
3141 /* Do we need to copy timestamp ? */
3143 tbuf
.actime
= fbuf
.st_atime
;
3144 tbuf
.modtime
= fbuf
.st_mtime
;
3146 if (utime (to
, &tbuf
) == -1) {
3151 /* Do we need to copy file permissions ? */
3152 if (mode
!= 0 && (chmod (to
, fbuf
.st_mode
) == -1)) {
3161 __gnat_lseek (int fd
, long offset
, int whence
)
3163 return (int) lseek (fd
, offset
, whence
);
3166 /* This function returns the major version number of GCC being used. */
3168 get_gcc_version (void)
3173 return (int) (version_string
[0] - '0');
3178 * Set Close_On_Exec as indicated.
3179 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
3183 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED
,
3184 int close_on_exec_p ATTRIBUTE_UNUSED
)
3186 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3187 int flags
= fcntl (fd
, F_GETFD
, 0);
3190 if (close_on_exec_p
)
3191 flags
|= FD_CLOEXEC
;
3193 flags
&= ~FD_CLOEXEC
;
3194 return fcntl (fd
, F_SETFD
, flags
);
3195 #elif defined(_WIN32)
3196 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
3197 if (h
== (HANDLE
) -1)
3199 if (close_on_exec_p
)
3200 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
, 0);
3201 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
,
3202 HANDLE_FLAG_INHERIT
);
3204 /* TODO: Unimplemented. */
3209 /* Indicates if platforms supports automatic initialization through the
3210 constructor mechanism */
3212 __gnat_binder_supports_auto_init (void)
3217 /* Indicates that Stand-Alone Libraries are automatically initialized through
3218 the constructor mechanism */
3220 __gnat_sals_init_using_constructors (void)
3222 #if defined (__vxworks) || defined (__Lynx__)
3229 #if defined (__linux__) || defined (__ANDROID__)
3230 /* There is no function in the glibc to retrieve the LWP of the current
3231 thread. We need to do a system call in order to retrieve this
3233 #include <sys/syscall.h>
3235 __gnat_lwp_self (void)
3237 return (void *) syscall (__NR_gettid
);
3241 #if defined (__APPLE__)
3242 #include <mach/thread_info.h>
3243 #include <mach/mach_init.h>
3244 #include <mach/thread_act.h>
3246 /* System-wide thread identifier. Note it could be truncated on 32 bit
3248 Previously was: pthread_mach_thread_np (pthread_self ()). */
3250 __gnat_lwp_self (void)
3252 thread_identifier_info_data_t data
;
3253 mach_msg_type_number_t count
= THREAD_IDENTIFIER_INFO_COUNT
;
3256 kret
= thread_info (mach_thread_self (), THREAD_IDENTIFIER_INFO
,
3257 (thread_info_t
) &data
, &count
);
3258 if (kret
== KERN_SUCCESS
)
3259 return (void *)(uintptr_t)data
.thread_id
;
3265 #if defined (__linux__)
3268 /* glibc versions earlier than 2.7 do not define the routines to handle
3269 dynamically allocated CPU sets. For these targets, we use the static
3274 /* Dynamic cpu sets */
3277 __gnat_cpu_alloc (size_t count
)
3279 return CPU_ALLOC (count
);
3283 __gnat_cpu_alloc_size (size_t count
)
3285 return CPU_ALLOC_SIZE (count
);
3289 __gnat_cpu_free (cpu_set_t
*set
)
3295 __gnat_cpu_zero (size_t count
, cpu_set_t
*set
)
3297 CPU_ZERO_S (count
, set
);
3301 __gnat_cpu_set (int cpu
, size_t count
, cpu_set_t
*set
)
3303 /* Ada handles CPU numbers starting from 1, while C identifies the first
3304 CPU by a 0, so we need to adjust. */
3305 CPU_SET_S (cpu
- 1, count
, set
);
3308 #else /* !CPU_ALLOC */
3310 /* Static cpu sets */
3313 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED
)
3315 return (cpu_set_t
*) xmalloc (sizeof (cpu_set_t
));
3319 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED
)
3321 return sizeof (cpu_set_t
);
3325 __gnat_cpu_free (cpu_set_t
*set
)
3331 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3337 __gnat_cpu_set (int cpu
, size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3339 /* Ada handles CPU numbers starting from 1, while C identifies the first
3340 CPU by a 0, so we need to adjust. */
3341 CPU_SET (cpu
- 1, set
);
3343 #endif /* !CPU_ALLOC */
3344 #endif /* __linux__ */
3346 /* Return the load address of the executable, or 0 if not known. In the
3347 specific case of error, (void *)-1 can be returned. Beware: this unit may
3348 be in a shared library. As low-level units are needed, we allow #include
3351 #if defined (__APPLE__)
3352 #include <mach-o/dyld.h>
3356 __gnat_get_executable_load_address (void)
3358 #if defined (__APPLE__)
3359 return _dyld_get_image_header (0);
3361 #elif 0 && defined (__linux__)
3362 /* Currently disabled as it needs at least -ldl. */
3363 struct link_map
*map
= _r_debug
.r_map
;
3365 return (const void *)map
->l_addr
;
3373 __gnat_kill (int pid
, int sig
, int close ATTRIBUTE_UNUSED
)
3376 HANDLE h
= OpenProcess (PROCESS_ALL_ACCESS
, FALSE
, pid
);
3381 TerminateProcess (h
, 1);
3383 else if (sig
== SIGINT
)
3384 GenerateConsoleCtrlEvent (CTRL_C_EVENT
, pid
);
3385 else if (sig
== SIGBREAK
)
3386 GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT
, pid
);
3387 /* ??? The last two alternatives don't really work. SIGBREAK requires setting
3388 up process groups at start time which we don't do; treating SIGINT is just
3389 not possible apparently. So we really only support signal 9. Fortunately
3390 that's all we use in GNAT.Expect */
3393 #elif defined (__vxworks)
3394 /* Not implemented */
3400 void __gnat_killprocesstree (int pid
, int sig_num
)
3405 memset(&pe
, 0, sizeof(PROCESSENTRY32
));
3406 pe
.dwSize
= sizeof(PROCESSENTRY32
);
3408 HANDLE hSnap
= CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS
, 0);
3410 /* cannot take snapshot, just kill the parent process */
3412 if (hSnap
== INVALID_HANDLE_VALUE
)
3414 __gnat_kill (pid
, sig_num
, 1);
3418 if (Process32First(hSnap
, &pe
))
3420 BOOL bContinue
= TRUE
;
3422 /* kill child processes first */
3426 if (pe
.th32ParentProcessID
== (DWORD
)pid
)
3427 __gnat_killprocesstree (pe
.th32ProcessID
, sig_num
);
3429 bContinue
= Process32Next (hSnap
, &pe
);
3433 CloseHandle (hSnap
);
3437 __gnat_kill (pid
, sig_num
, 1);
3439 #elif defined (__vxworks)
3440 /* not implemented */
3442 #elif defined (__linux__)
3446 /* read all processes' pid and ppid */
3448 dir
= opendir ("/proc");
3450 /* cannot open proc, just kill the parent process */
3454 __gnat_kill (pid
, sig_num
, 1);
3458 /* kill child processes first */
3460 while ((d
= readdir (dir
)) != NULL
)
3462 if ((d
->d_type
& DT_DIR
) == DT_DIR
)
3467 /* read /proc/<PID>/stat */
3469 if (strlen (d
->d_name
) >= sizeof (statfile
) - strlen ("/proc//stat"))
3471 strcpy (statfile
, "/proc/");
3472 strcat (statfile
, d
->d_name
);
3473 strcat (statfile
, "/stat");
3475 FILE *fd
= fopen (statfile
, "r");
3479 const int match
= fscanf (fd
, "%d %*s %*s %d", &_pid
, &_ppid
);
3482 if (match
== 2 && _ppid
== pid
)
3483 __gnat_killprocesstree (_pid
, sig_num
);
3492 __gnat_kill (pid
, sig_num
, 1);
3494 __gnat_kill (pid
, sig_num
, 1);
3496 /* Note on Solaris it is possible to read /proc/<PID>/status.
3497 The 5th and 6th words are the pid and the 7th and 8th the ppid.
3498 See: /usr/include/sys/procfs.h (struct pstatus).