From patchwork Thu Jan 12 19:24:28 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 135683 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 02213B6FD0 for ; Fri, 13 Jan 2012 06:25:00 +1100 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1327001102; h=Comment: DomainKey-Signature:Received:Received:Received:Received: Message-ID:Date:From:User-Agent:MIME-Version:To:Subject: Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:Sender:Delivered-To; bh=B0IYRt4 eZ68QNwFwMo6OpiflBZM=; b=SQqcWNNzVrP466KtGYMJU/oGGVIP5yAm3xQxJII a/57tvTX/fIWL9wFn6lr2SnyQGz6cX4aEFKks+3JKGkqeuLZlaDiOc6LWK4FZVog +tCQUTAybEleAS4dvd33Y5y3oeiq8mkiLT0eGdGwzcYgjL8/ynhF6QgR5KjbZzsG XaYk= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Message-ID:Date:From:User-Agent:MIME-Version:To:Subject:Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=l6QiqcgkFzSLpKbOkIVR+fB7AoTUErDz5jPn4SruB0sMaDQK61lchLfOz1qX91 OcxJT4vMPhqZIm//kR7GCUYvqLQKatV/9xiULluz0hXsY227HvS6v9QYC5eImeCS YwhLJ7WlKSkdshEfElHVRrwRFsPnt+bQ+2HvV2So0xPok=; Received: (qmail 25686 invoked by alias); 12 Jan 2012 19:24:54 -0000 Received: (qmail 25670 invoked by uid 22791); 12 Jan 2012 19:24:52 -0000 X-SWARE-Spam-Status: No, hits=-1.6 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, TW_BG, TW_CP, TW_RW X-Spam-Check-By: sourceware.org Received: from mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 12 Jan 2012 19:24:31 +0000 Received: from [192.168.178.22] (port-92-204-59-150.dynamic.qsc.de [92.204.59.150]) by mx01.qsc.de (Postfix) with ESMTP id 3E5AF3CEAB; Thu, 12 Jan 2012 20:24:29 +0100 (CET) Message-ID: <4F0F336C.3070503@net-b.de> Date: Thu, 12 Jan 2012 20:24:28 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:9.0) Gecko/20111220 Thunderbird/9.0 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR36755 Use a library call instead of calling chmod() Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 " 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 PR fortran/36755 * intrinsic.texi (CHMOD): Extend a bit and remove statement that /bin/chmod is called. 2012-01-12 Tobias Burnus 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 -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 -#include +#if defined(HAVE_SYS_STAT_H) -#ifdef HAVE_UNISTD_H -#include -#endif -#ifdef HAVE_SYS_WAIT_H -#include -#endif +#include +#include /* For memcpy. */ +#include /* 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: + [][|][[|],...] + - 'u', 'g', 'o', 'a' + - '+', '-', '=' + - 'r', 'w', 'x', 'X', 's', t' + If 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 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); }