OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
1cef710256
gcc/libgfortran/intrinsics/chmod.c
Tobias Burnus 9c69933102 re PR libfortran/36755 (Avoid fork/exec in chmod intrinsic) 
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

From-SVN: r183137
2012-01-12 21:26:10 +01:00

478 lines
11 KiB
C
Raw Blame History

/* Implementation of the CHMOD intrinsic.
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 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#if defined(HAVE_SYS_STAT_H)
#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.
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.
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);
int
chmod_func (char *name, char *mode, gfc_charlen_type name_len,
gfc_charlen_type mode_len)
{
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 of the file name. */
while (name_len > 0 && name[name_len - 1] == ' ')
name_len--;
/* Make a null terminated copy of the file name. */
file = gfc_alloca (name_len + 1);
memcpy (file, name, name_len);
file[name_len] = '\0';
if (mode_len == 0)
return 1;
if (mode[0] >= '0' && mode[0] <= '9')
{
if (sscanf (mode, "%o", &file_mode) != 1)
return 1;
return chmod (file, file_mode);
}
/* 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);
}
extern void chmod_i4_sub (char *, char *, GFC_INTEGER_4 *,
gfc_charlen_type, gfc_charlen_type);
export_proto(chmod_i4_sub);
void
chmod_i4_sub (char *name, char *mode, GFC_INTEGER_4 * status,
gfc_charlen_type name_len, gfc_charlen_type mode_len)
{
int val;
val = chmod_func (name, mode, name_len, mode_len);
if (status)
*status = val;
}
extern void chmod_i8_sub (char *, char *, GFC_INTEGER_8 *,
gfc_charlen_type, gfc_charlen_type);
export_proto(chmod_i8_sub);
void
chmod_i8_sub (char *name, char *mode, GFC_INTEGER_8 * status,
gfc_charlen_type name_len, gfc_charlen_type mode_len)
{
int val;
val = chmod_func (name, mode, name_len, mode_len);
if (status)
*status = val;
}
#endif
Reference in New Issue View Git Blame Copy Permalink