Patchwork [Fortran] PR36755 Use a library call instead of calling chmod()

login
register
mail settings
Submitter Tobias Burnus
Date Jan. 12, 2012, 7:24 p.m.
Message ID <4F0F336C.3070503@net-b.de>
Download mbox | patch
Permalink /patch/135683/
State New
Headers show

Comments

Tobias Burnus - Jan. 12, 2012, 7:24 p.m.
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
Janne Blomqvist - Jan. 12, 2012, 8:15 p.m.
On Thu, Jan 12, 2012 at 21:24, Tobias Burnus <burnus@net-b.de> wrote:
> 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 ;-)

Nice! While this technically isn't a regression, I think it's safe
enough for 4.7; some obscure modestring not working as expected is
unlikely to be the end of the world, and it might take years for such
issues to surface anyway. For such bugs, or for potential mode strings
not supported by POSIX, an easy workaround is after all to call
/bin/chmod with EXECUTE_COMMAND_LINE or SYSTEM. So, Ok for trunk.

Patch

2012-01-12  Tobias Burnus  <burnus@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  <burnus@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 <coudert@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);
 }