This patch changes the handling of the CHMOD intrinsic.
Currently, libgfortran calls /bin/chmod via fork/exec. The problem is on
one hand that the re-implemented system() call is not 100% correct.
On the other hand, it will not work on systems where /bin/chmod is not
available. For instance, RTEMS is such a system, which offers chmod()
but not /bin/chmod.
The tricky part is that chmod() only supports an (octal) number for the
permissions. By contrast, the chmod utilility supports a much richer
symbolic syntax in addition.
I have to admit that I had never expect a that complicated syntax, but
the patch also handles:
umask 022; mkdir foo; my_chmod g+w-r,a+x,-w,o=u,u+s,+t foo
That's just a few lines of Fortran code (plus the attached patch for the
library):
program my_chmod
integer :: stat
character(len=200) :: file, mode
if (COMMAND_ARGUMENT_COUNT() /=2 ) error stop "USAGE: my_chmod <file>
<mode>"
CALL GET_COMMAND_ARGUMENT(1,mode)
CALL GET_COMMAND_ARGUMENT(2,file)
call chmod(file, mode, stat)
if (stat /= 0) error stop "my_stat FAILED"
end program my_chmod
Build and tested on x86-64-linux.
OK for the trunk? (4.7 or 4.8 ;-)
Tobias
2012-01-12 Tobias Burnus <bur...@net-b.de>
PR fortran/36755
* intrinsic.texi (CHMOD): Extend a bit and remove statement
that /bin/chmod is called.
2012-01-12 Tobias Burnus <bur...@net-b.de>
PR fortran/36755
* intrinsics/chmod.c (chmod_func): Replace call to /bin/chmod
by a mode parser and a call to chmod().
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 6d4c9ff..892b7a1 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -2665,8 +2665,7 @@ END PROGRAM
@table @asis
@item @emph{Description}:
-@code{CHMOD} changes the permissions of a file. This function invokes
-@code{/bin/chmod} and might therefore not work on all platforms.
+@code{CHMOD} changes the permissions of a file.
This intrinsic is provided in both subroutine and function forms; however,
only one form can be used in any given program unit.
@@ -2692,8 +2691,9 @@ file name. Trailing blanks are ignored unless the character
@code{achar(0)} are used as the file name.
@item @var{MODE} @tab Scalar @code{CHARACTER} of default kind giving the
-file permission. @var{MODE} uses the same syntax as the @var{MODE}
-argument of @code{/bin/chmod}.
+file permission. @var{MODE} uses the same syntax as the @code{chmod} utility
+as defined by the POSIX standard. The argument shall either be a string of
+a nonnegative octal number or a symbolic mode.
@item @var{STATUS} @tab (optional) scalar @code{INTEGER}, which is
@code{0} on success and nonzero otherwise.
diff --git a/libgfortran/intrinsics/chmod.c b/libgfortran/intrinsics/chmod.c
index cf768ff..6c685f4 100644
--- a/libgfortran/intrinsics/chmod.c
+++ b/libgfortran/intrinsics/chmod.c
@@ -1,8 +1,8 @@
/* Implementation of the CHMOD intrinsic.
- Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc.
+ Copyright (C) 2006, 2007, 2009, 2012 Free Software Foundation, Inc.
Contributed by François-Xavier Coudert <coud...@clipper.ens.fr>
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
@@ -25,20 +25,39 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
-#include <errno.h>
-#include <string.h>
+#if defined(HAVE_SYS_STAT_H)
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-#ifdef HAVE_SYS_WAIT_H
-#include <sys/wait.h>
-#endif
+#include <stdbool.h>
+#include <string.h> /* For memcpy. */
+#include <sys/stat.h> /* For stat, chmod and umask. */
+
+
+/* INTEGER FUNCTION CHMOD (NAME, MODE)
+ CHARACTER(len=*), INTENT(IN) :: NAME, MODE
+
+ Sets the file permission "chmod" using a mode string.
-/* INTEGER FUNCTION ACCESS(NAME, MODE)
- CHARACTER(len=*), INTENT(IN) :: NAME, MODE */
+ The mode string allows for the same arguments as POSIX's chmod utility.
+ a) string containing an octal number.
+ b) Comma separated list of clauses of the form:
+ [<who-list>]<op>[<perm-list>|<permcopy>][<op>[<perm-list>|<permcopy>],...]
+ <who> - 'u', 'g', 'o', 'a'
+ <op> - '+', '-', '='
+ <perm> - 'r', 'w', 'x', 'X', 's', t'
+ If <op> is not followed by a perm-list or permcopy, '-' and '+' do not
+ change the mode while '=' clears all file mode bits. 'u' stands for the
+ user permissions, 'g' for the group and 'o' for the permissions for others.
+ 'a' is equivalent to 'ugo'. '+' sets the given permission in addition to
+ the ones of the file, '-' unsets the given permissions of the file, while
+ '=' sets the file to that mode. 'r' sets the read, 'w' the write, and
+ 'x' the execute mode. 'X' sets the execute bit if the file is a directory
+ or if the user, group or other executable bit is set. 't' sets the sticky
+ bit, 's' (un)sets the and/or S_ISUID/S_ISGID bit.
-#if defined(HAVE_FORK) && defined(HAVE_EXECL) && defined(HAVE_WAIT)
+ Note that if <who> is omitted, the permissions are filtered by the umask.
+
+ A return value of 0 indicates success, -1 an error of chmod() while 1
+ indicates a mode parsing error. */
extern int chmod_func (char *, char *, gfc_charlen_type, gfc_charlen_type);
export_proto(chmod_func);
@@ -47,41 +66,379 @@ int
chmod_func (char *name, char *mode, gfc_charlen_type name_len,
gfc_charlen_type mode_len)
{
- char * file, * m;
- pid_t pid;
- int status;
+ char * file;
+ int i;
+ bool ugo[3];
+ bool rwxXstugo[9];
+ int set_mode, part;
+ bool is_dir, honor_umask, continue_clause = false;
+ mode_t mode_mask, file_mode, new_mode;
+ struct stat stat_buf;
- /* Trim trailing spaces. */
+ /* Trim trailing spaces of the file name. */
while (name_len > 0 && name[name_len - 1] == ' ')
name_len--;
- while (mode_len > 0 && mode[mode_len - 1] == ' ')
- mode_len--;
- /* Make a null terminated copy of the strings. */
+ /* Make a null terminated copy of the file name. */
file = gfc_alloca (name_len + 1);
memcpy (file, name, name_len);
file[name_len] = '\0';
- m = gfc_alloca (mode_len + 1);
- memcpy (m, mode, mode_len);
- m[mode_len]= '\0';
+ if (mode_len == 0)
+ return 1;
- /* Execute /bin/chmod. */
- if ((pid = fork()) < 0)
- return errno;
- if (pid == 0)
+ if (mode[0] >= '0' && mode[0] <= '9')
{
- /* Child process. */
- execl ("/bin/chmod", "chmod", m, file, (char *) NULL);
- return errno;
+ if (sscanf (mode, "%o", &file_mode) != 1)
+ return 1;
+ return chmod (file, file_mode);
}
- else
- wait (&status);
- if (WIFEXITED(status))
- return WEXITSTATUS(status);
- else
- return -1;
+ /* Read the current file mode. */
+ if (stat (file, &stat_buf))
+ return 1;
+
+ file_mode = stat_buf.st_mode & ~S_IFMT;
+ is_dir = stat_buf.st_mode & S_IFDIR;
+
+ /* Obtain the umask without distroying the setting. */
+ mode_mask = 0;
+ mode_mask = umask (mode_mask);
+ (void) umask (mode_mask);
+
+ for (i = 0; i < mode_len; i++)
+ {
+ if (!continue_clause)
+ {
+ ugo[0] = false;
+ ugo[1] = false;
+ ugo[2] = false;
+ honor_umask = true;
+ }
+ continue_clause = false;
+ rwxXstugo[0] = false;
+ rwxXstugo[1] = false;
+ rwxXstugo[2] = false;
+ rwxXstugo[3] = false;
+ rwxXstugo[4] = false;
+ rwxXstugo[5] = false;
+ rwxXstugo[6] = false;
+ rwxXstugo[7] = false;
+ rwxXstugo[8] = false;
+ rwxXstugo[9] = false;
+ part = 0;
+ set_mode = -1;
+ for (; i < mode_len; i++)
+ {
+ switch (mode[i])
+ {
+ /* User setting: a[ll]/u[ser]/g[roup]/o[ther]. */
+ case 'a':
+ if (part > 1)
+ return 1;
+ ugo[0] = true;
+ ugo[1] = true;
+ ugo[2] = true;
+ part = 1;
+ honor_umask = false;
+ break;
+ case 'u':
+ if (part == 2)
+ {
+ rwxXstugo[6] = true;
+ part = 4;
+ break;
+ }
+ if (part > 1)
+ return 1;
+ ugo[0] = true;
+ part = 1;
+ honor_umask = false;
+ break;
+ case 'g':
+ if (part == 2)
+ {
+ rwxXstugo[7] = true;
+ part = 4;
+ break;
+ }
+ if (part > 1)
+ return 1;
+ ugo[1] = true;
+ part = 1;
+ honor_umask = false;
+ break;
+ case 'o':
+ if (part == 2)
+ {
+ rwxXstugo[8] = true;
+ part = 4;
+ break;
+ }
+ if (part > 1)
+ return 1;
+ ugo[2] = true;
+ part = 1;
+ honor_umask = false;
+ break;
+
+ /* Mode setting: =+-. */
+ case '=':
+ if (part > 2)
+ {
+ continue_clause = true;
+ i--;
+ part = 2;
+ goto clause_done;
+ }
+ set_mode = 1;
+ part = 2;
+ break;
+
+ case '-':
+ if (part > 2)
+ {
+ continue_clause = true;
+ i--;
+ part = 2;
+ goto clause_done;
+ }
+ set_mode = 2;
+ part = 2;
+ break;
+
+ case '+':
+ if (part > 2)
+ {
+ continue_clause = true;
+ i--;
+ part = 2;
+ goto clause_done;
+ }
+ set_mode = 3;
+ part = 2;
+ break;
+
+ /* Permissions: rwxXst - for ugo see above. */
+ case 'r':
+ if (part != 2 && part != 3)
+ return 1;
+ rwxXstugo[0] = true;
+ part = 3;
+ break;
+
+ case 'w':
+ if (part != 2 && part != 3)
+ return 1;
+ rwxXstugo[1] = true;
+ part = 3;
+ break;
+
+ case 'x':
+ if (part != 2 && part != 3)
+ return 1;
+ rwxXstugo[2] = true;
+ part = 3;
+ break;
+
+ case 'X':
+ if (part != 2 && part != 3)
+ return 1;
+ rwxXstugo[3] = true;
+ part = 3;
+ break;
+
+ case 's':
+ if (part != 2 && part != 3)
+ return 1;
+ rwxXstugo[4] = true;
+ part = 3;
+ break;
+
+ case 't':
+ if (part != 2 && part != 3)
+ return 1;
+ rwxXstugo[5] = true;
+ part = 3;
+ break;
+
+ /* Tailing blanks are valid in Fortran. */
+ case ' ':
+ for (i++; i < mode_len; i++)
+ if (mode[i] != ' ')
+ break;
+ if (i != mode_len)
+ return 1;
+ goto clause_done;
+
+ case ',':
+ goto clause_done;
+
+ default:
+ return 1;
+ }
+ }
+
+clause_done:
+ if (part < 2)
+ return 1;
+
+ new_mode = 0;
+
+ /* Read. */
+ if (rwxXstugo[0])
+ {
+ if (ugo[0] || honor_umask)
+ new_mode |= S_IRUSR;
+ if (ugo[1] || honor_umask)
+ new_mode |= S_IRGRP;
+ if (ugo[2] || honor_umask)
+ new_mode |= S_IROTH;
+ }
+
+ /* Write. */
+ if (rwxXstugo[1])
+ {
+ if (ugo[0] || honor_umask)
+ new_mode |= S_IWUSR;
+ if (ugo[1] || honor_umask)
+ new_mode |= S_IWGRP;
+ if (ugo[2] || honor_umask)
+ new_mode |= S_IWOTH;
+ }
+
+ /* Execute. */
+ if (rwxXstugo[2])
+ {
+ if (ugo[0] || honor_umask)
+ new_mode |= S_IXUSR;
+ if (ugo[1] || honor_umask)
+ new_mode |= S_IXGRP;
+ if (ugo[2] || honor_umask)
+ new_mode |= S_IXOTH;
+ }
+
+ /* 'X' execute. */
+ if (rwxXstugo[3]
+ && (is_dir || (file_mode & (S_IXUSR | S_IXGRP | S_IXOTH))))
+ new_mode |= (S_IXUSR | S_IXGRP | S_IXOTH);
+
+ /* 's'. */
+ if (rwxXstugo[4])
+ {
+ if (ugo[0] || honor_umask)
+ new_mode |= S_ISUID;
+ if (ugo[1] || honor_umask)
+ new_mode |= S_ISGID;
+ }
+
+ /* As original 'u'. */
+ if (rwxXstugo[6])
+ {
+ if (ugo[1] || honor_umask)
+ {
+ if (file_mode & S_IRUSR)
+ new_mode |= S_IRGRP;
+ if (file_mode & S_IWUSR)
+ new_mode |= S_IWGRP;
+ if (file_mode & S_IXUSR)
+ new_mode |= S_IXGRP;
+ }
+ if (ugo[2] || honor_umask)
+ {
+ if (file_mode & S_IRUSR)
+ new_mode |= S_IROTH;
+ if (file_mode & S_IWUSR)
+ new_mode |= S_IWOTH;
+ if (file_mode & S_IXUSR)
+ new_mode |= S_IXOTH;
+ }
+ }
+
+ /* As original 'g'. */
+ if (rwxXstugo[7])
+ {
+ if (ugo[0] || honor_umask)
+ {
+ if (file_mode & S_IRGRP)
+ new_mode |= S_IRUSR;
+ if (file_mode & S_IWGRP)
+ new_mode |= S_IWUSR;
+ if (file_mode & S_IXGRP)
+ new_mode |= S_IXUSR;
+ }
+ if (ugo[2] || honor_umask)
+ {
+ if (file_mode & S_IRGRP)
+ new_mode |= S_IROTH;
+ if (file_mode & S_IWGRP)
+ new_mode |= S_IWOTH;
+ if (file_mode & S_IXGRP)
+ new_mode |= S_IXOTH;
+ }
+ }
+
+ /* As original 'o'. */
+ if (rwxXstugo[8])
+ {
+ if (ugo[0] || honor_umask)
+ {
+ if (file_mode & S_IROTH)
+ new_mode |= S_IRUSR;
+ if (file_mode & S_IWOTH)
+ new_mode |= S_IWUSR;
+ if (file_mode & S_IXOTH)
+ new_mode |= S_IXUSR;
+ }
+ if (ugo[1] || honor_umask)
+ {
+ if (file_mode & S_IROTH)
+ new_mode |= S_IRGRP;
+ if (file_mode & S_IWOTH)
+ new_mode |= S_IWGRP;
+ if (file_mode & S_IXOTH)
+ new_mode |= S_IXGRP;
+ }
+ }
+
+ if (honor_umask)
+ new_mode &= ~mode_mask;
+
+ if (set_mode == 1)
+ {
+ /* Set '='. */
+ if ((ugo[0] || honor_umask) && !rwxXstugo[6])
+ file_mode = (file_mode & ~(S_ISUID | S_IRUSR | S_IWUSR | S_IXUSR))
+ | (new_mode & (S_ISUID | S_IRUSR | S_IWUSR | S_IXUSR));
+ if ((ugo[1] || honor_umask) && !rwxXstugo[7])
+ file_mode = (file_mode & ~(S_ISGID | S_IRGRP | S_IWGRP | S_IXGRP))
+ | (new_mode & (S_ISGID | S_IRGRP | S_IWGRP | S_IXGRP));
+ if ((ugo[2] || honor_umask) && !rwxXstugo[8])
+ file_mode = (file_mode & ~(S_IROTH | S_IWOTH | S_IXOTH))
+ | (new_mode & (S_IROTH | S_IWOTH | S_IXOTH));
+ if (is_dir && rwxXstugo[5])
+ file_mode |= S_ISVTX;
+ else if (!is_dir)
+ file_mode &= ~S_ISVTX;
+ }
+ else if (set_mode == 2)
+ {
+ /* Clear '-'. */
+ file_mode &= ~new_mode;
+ if (rwxXstugo[5] || !is_dir)
+ file_mode &= ~S_ISVTX;
+ }
+ else if (set_mode == 3)
+ {
+ file_mode |= new_mode;
+ if (rwxXstugo[5] && is_dir)
+ file_mode |= S_ISVTX;
+ else if (!is_dir)
+ file_mode &= ~S_ISVTX;
+ }
+ }
+
+ return chmod (file, file_mode);
}
