libgfortran/intrinsics/chmod.c

   1 /* Implementation of the CHMOD intrinsic.
   2    Copyright (C) 2006-2017 Free Software Foundation, Inc.
   3    Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
   4
   5 This file is part of the GNU Fortran runtime library (libgfortran).
   6
   7 Libgfortran is free software; you can redistribute it and/or
   8 modify it under the terms of the GNU General Public
   9 License as published by the Free Software Foundation; either
  10 version 3 of the License, or (at your option) any later version.
  11
  12 Libgfortran is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 Under Section 7 of GPL version 3, you are granted additional
  18 permissions described in the GCC Runtime Library Exception, version
  19 3.1, as published by the Free Software Foundation.
  20
  21 You should have received a copy of the GNU General Public License and
  22 a copy of the GCC Runtime Library Exception along with this program;
  23 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  24 <http://www.gnu.org/licenses/>.  */
  25
  26 #include "libgfortran.h"
  27
  28 #if defined(HAVE_SYS_STAT_H)
  29
  30 #include <sys/stat.h>   /* For stat, chmod and umask.  */
  31
  32
  33 /* INTEGER FUNCTION CHMOD (NAME, MODE)
  34    CHARACTER(len=*), INTENT(IN) :: NAME, MODE
  35
  36    Sets the file permission "chmod" using a mode string.
  37
  38    For MinGW, only _S_IWRITE and _S_IREAD are supported. To set those,
  39    only the user attributes are used.
  40
  41    The mode string allows for the same arguments as POSIX's chmod utility.
  42    a) string containing an octal number.
  43    b) Comma separated list of clauses of the form:
  44       [<who-list>]<op>[<perm-list>|<permcopy>][<op>[<perm-list>|<permcopy>],...]
  45       <who> - 'u', 'g', 'o', 'a'
  46       <op>  - '+', '-', '='
  47       <perm> - 'r', 'w', 'x', 'X', 's', t'
  48    If <op> is not followed by a perm-list or permcopy, '-' and '+' do not
  49    change the mode while '=' clears all file mode bits. 'u' stands for the
  50    user permissions, 'g' for the group and 'o' for the permissions for others.
  51    'a' is equivalent to 'ugo'. '+' sets the given permission in addition to
  52    the ones of the file, '-' unsets the given permissions of the file, while
  53    '=' sets the file to that mode. 'r' sets the read, 'w' the write, and
  54    'x' the execute mode. 'X' sets the execute bit if the file is a directory
  55    or if the user, group or other executable bit is set. 't' sets the sticky
  56    bit, 's' (un)sets the and/or S_ISUID/S_ISGID bit.
  57
  58    Note that if <who> is omitted, the permissions are filtered by the umask.
  59
  60    A return value of 0 indicates success, -1 an error of chmod() while 1
  61    indicates a mode parsing error.  */
  62
  63
  64 static int
  65 chmod_internal (char *file, char *mode, gfc_charlen_type mode_len)
  66 {
  67   int i;
  68   bool ugo[3];
  69   bool rwxXstugo[9];
  70   int set_mode, part;
  71   bool honor_umask, continue_clause = false;
  72 #ifndef __MINGW32__
  73   bool is_dir;
  74 #endif
  75   mode_t mode_mask, file_mode, new_mode;
  76   struct stat stat_buf;
  77
  78   if (mode_len == 0)
  79     return 1;
  80
  81   if (mode[0] >= '0' && mode[0] <= '9')
  82     {
  83       unsigned fmode;
  84       if (sscanf (mode, "%o", &fmode) != 1)
  85         return 1;
  86       return chmod (file, (mode_t) fmode);
  87     }
  88
  89   /* Read the current file mode. */
  90   if (stat (file, &stat_buf))
  91     return 1;
  92
  93   file_mode = stat_buf.st_mode & ~S_IFMT;
  94 #ifndef __MINGW32__
  95   is_dir = stat_buf.st_mode & S_IFDIR;
  96 #endif
  97
  98 #ifdef HAVE_UMASK
  99   /* Obtain the umask without distroying the setting.  */
 100   mode_mask = 0;
 101   mode_mask = umask (mode_mask);
 102   (void) umask (mode_mask);
 103 #else
 104   honor_umask = false;
 105 #endif
 106
 107   for (i = 0; i < mode_len; i++)
 108     {
 109       if (!continue_clause)
 110         {
 111           ugo[0] = false;
 112           ugo[1] = false;
 113           ugo[2] = false;
 114 #ifdef HAVE_UMASK
 115           honor_umask = true;
 116 #endif
 117         }
 118       continue_clause = false;
 119       rwxXstugo[0] = false;
 120       rwxXstugo[1] = false;
 121       rwxXstugo[2] = false;
 122       rwxXstugo[3] = false;
 123       rwxXstugo[4] = false;
 124       rwxXstugo[5] = false;
 125       rwxXstugo[6] = false;
 126       rwxXstugo[7] = false;
 127       rwxXstugo[8] = false;
 128       part = 0;
 129       set_mode = -1;
 130       for (; i < mode_len; i++)
 131         {
 132           switch (mode[i])
 133             {
 134             /* User setting: a[ll]/u[ser]/g[roup]/o[ther].  */
 135             case 'a':
 136               if (part > 1)
 137                 return 1;
 138               ugo[0] = true;
 139               ugo[1] = true;
 140               ugo[2] = true;
 141               part = 1;
 142 #ifdef HAVE_UMASK
 143               honor_umask = false;
 144 #endif
 145               break;
 146             case 'u':
 147               if (part == 2)
 148                 {
 149                   rwxXstugo[6] = true;
 150                   part = 4;
 151                   break;
 152                 }
 153               if (part > 1)
 154                 return 1;
 155               ugo[0] = true;
 156               part = 1;
 157 #ifdef HAVE_UMASK
 158               honor_umask = false;
 159 #endif
 160               break;
 161             case 'g':
 162               if (part == 2)
 163                 {
 164                   rwxXstugo[7] = true;
 165                   part = 4;
 166                   break;
 167                 }
 168               if (part > 1)
 169                 return 1;
 170               ugo[1] = true;
 171               part = 1;
 172 #ifdef HAVE_UMASK
 173               honor_umask = false;
 174 #endif
 175               break;
 176             case 'o':
 177               if (part == 2)
 178                 {
 179                   rwxXstugo[8] = true;
 180                   part = 4;
 181                   break;
 182                 }
 183               if (part > 1)
 184                 return 1;
 185               ugo[2] = true;
 186               part = 1;
 187 #ifdef HAVE_UMASK
 188               honor_umask = false;
 189 #endif
 190               break;
 191
 192             /* Mode setting: =+-.  */
 193             case '=':
 194               if (part > 2)
 195                 {
 196                   continue_clause = true;
 197                   i--;
 198                   part = 2;
 199                   goto clause_done;
 200                 }
 201               set_mode = 1;
 202               part = 2;
 203               break;
 204
 205             case '-':
 206               if (part > 2)
 207                 {
 208                   continue_clause = true;
 209                   i--;
 210                   part = 2;
 211                   goto clause_done;
 212                 }
 213               set_mode = 2;
 214               part = 2;
 215               break;
 216
 217             case '+':
 218               if (part > 2)
 219                 {
 220                   continue_clause = true;
 221                   i--;
 222                   part = 2;
 223                   goto clause_done;
 224                 }
 225               set_mode = 3;
 226               part = 2;
 227               break;
 228
 229             /* Permissions: rwxXst - for ugo see above.  */
 230             case 'r':
 231               if (part != 2 && part != 3)
 232                 return 1;
 233               rwxXstugo[0] = true;
 234               part = 3;
 235               break;
 236
 237             case 'w':
 238               if (part != 2 && part != 3)
 239                 return 1;
 240               rwxXstugo[1] = true;
 241               part = 3;
 242               break;
 243
 244             case 'x':
 245               if (part != 2 && part != 3)
 246                 return 1;
 247               rwxXstugo[2] = true;
 248               part = 3;
 249               break;
 250
 251             case 'X':
 252               if (part != 2 && part != 3)
 253                 return 1;
 254               rwxXstugo[3] = true;
 255               part = 3;
 256               break;
 257
 258             case 's':
 259               if (part != 2 && part != 3)
 260                 return 1;
 261               rwxXstugo[4] = true;
 262               part = 3;
 263               break;
 264
 265             case 't':
 266               if (part != 2 && part != 3)
 267                 return 1;
 268               rwxXstugo[5] = true;
 269               part = 3;
 270               break;
 271
 272             /* Tailing blanks are valid in Fortran.  */
 273             case ' ':
 274               for (i++; i < mode_len; i++)
 275                 if (mode[i] != ' ')
 276                   break;
 277               if (i != mode_len)
 278                 return 1;
 279               goto clause_done;
 280
 281             case ',':
 282               goto clause_done;
 283
 284             default:
 285               return 1;
 286             }
 287         }
 288
 289 clause_done:
 290       if (part < 2)
 291         return 1;
 292
 293       new_mode = 0;
 294
 295 #ifdef __MINGW32__
 296
 297       /* Read. */
 298       if (rwxXstugo[0] && (ugo[0] || honor_umask))
 299         new_mode |= _S_IREAD;
 300
 301       /* Write. */
 302       if (rwxXstugo[1] && (ugo[0] || honor_umask))
 303         new_mode |= _S_IWRITE;
 304
 305 #else
 306
 307       /* Read. */
 308       if (rwxXstugo[0])
 309         {
 310           if (ugo[0] || honor_umask)
 311             new_mode |= S_IRUSR;
 312           if (ugo[1] || honor_umask)
 313             new_mode |= S_IRGRP;
 314           if (ugo[2] || honor_umask)
 315             new_mode |= S_IROTH;
 316         }
 317
 318       /* Write.  */
 319       if (rwxXstugo[1])
 320         {
 321           if (ugo[0] || honor_umask)
 322             new_mode |= S_IWUSR;
 323           if (ugo[1] || honor_umask)
 324             new_mode |= S_IWGRP;
 325           if (ugo[2] || honor_umask)
 326             new_mode |= S_IWOTH;
 327         }
 328
 329       /* Execute. */
 330       if (rwxXstugo[2])
 331         {
 332           if (ugo[0] || honor_umask)
 333             new_mode |= S_IXUSR;
 334           if (ugo[1] || honor_umask)
 335             new_mode |= S_IXGRP;
 336           if (ugo[2] || honor_umask)
 337             new_mode |= S_IXOTH;
 338         }
 339
 340       /* 'X' execute.  */
 341       if (rwxXstugo[3]
 342           && (is_dir || (file_mode & (S_IXUSR | S_IXGRP | S_IXOTH))))
 343         new_mode |= (S_IXUSR | S_IXGRP | S_IXOTH);
 344
 345       /* 's'.  */
 346       if (rwxXstugo[4])
 347         {
 348           if (ugo[0] || honor_umask)
 349             new_mode |= S_ISUID;
 350           if (ugo[1] || honor_umask)
 351             new_mode |= S_ISGID;
 352         }
 353
 354       /* As original 'u'.  */
 355       if (rwxXstugo[6])
 356         {
 357           if (ugo[1] || honor_umask)
 358             {
 359               if (file_mode & S_IRUSR)
 360                 new_mode |= S_IRGRP;
 361               if (file_mode & S_IWUSR)
 362                 new_mode |= S_IWGRP;
 363               if (file_mode & S_IXUSR)
 364                 new_mode |= S_IXGRP;
 365             }
 366           if (ugo[2] || honor_umask)
 367             {
 368               if (file_mode & S_IRUSR)
 369                 new_mode |= S_IROTH;
 370               if (file_mode & S_IWUSR)
 371                 new_mode |= S_IWOTH;
 372               if (file_mode & S_IXUSR)
 373                 new_mode |= S_IXOTH;
 374             }
 375         }
 376
 377       /* As original 'g'.  */
 378       if (rwxXstugo[7])
 379         {
 380           if (ugo[0] || honor_umask)
 381             {
 382               if (file_mode & S_IRGRP)
 383                 new_mode |= S_IRUSR;
 384               if (file_mode & S_IWGRP)
 385                 new_mode |= S_IWUSR;
 386               if (file_mode & S_IXGRP)
 387                 new_mode |= S_IXUSR;
 388             }
 389           if (ugo[2] || honor_umask)
 390             {
 391               if (file_mode & S_IRGRP)
 392                 new_mode |= S_IROTH;
 393               if (file_mode & S_IWGRP)
 394                 new_mode |= S_IWOTH;
 395               if (file_mode & S_IXGRP)
 396                 new_mode |= S_IXOTH;
 397             }
 398         }
 399
 400       /* As original 'o'.  */
 401       if (rwxXstugo[8])
 402         {
 403           if (ugo[0] || honor_umask)
 404             {
 405               if (file_mode & S_IROTH)
 406                 new_mode |= S_IRUSR;
 407               if (file_mode & S_IWOTH)
 408                 new_mode |= S_IWUSR;
 409               if (file_mode & S_IXOTH)
 410                 new_mode |= S_IXUSR;
 411             }
 412           if (ugo[1] || honor_umask)
 413             {
 414               if (file_mode & S_IROTH)
 415                 new_mode |= S_IRGRP;
 416               if (file_mode & S_IWOTH)
 417                 new_mode |= S_IWGRP;
 418               if (file_mode & S_IXOTH)
 419                 new_mode |= S_IXGRP;
 420             }
 421         }
 422 #endif  /* __MINGW32__ */
 423
 424 #ifdef HAVE_UMASK
 425     if (honor_umask)
 426       new_mode &= ~mode_mask;
 427 #endif
 428
 429     if (set_mode == 1)
 430       {
 431 #ifdef __MINGW32__
 432         if (ugo[0] || honor_umask)
 433           file_mode = (file_mode & ~(_S_IWRITE | _S_IREAD))
 434                       | (new_mode & (_S_IWRITE | _S_IREAD));
 435 #else
 436         /* Set '='.  */
 437         if ((ugo[0] || honor_umask) && !rwxXstugo[6])
 438           file_mode = (file_mode & ~(S_ISUID | S_IRUSR | S_IWUSR | S_IXUSR))
 439                       | (new_mode & (S_ISUID | S_IRUSR | S_IWUSR | S_IXUSR));
 440         if ((ugo[1] || honor_umask) && !rwxXstugo[7])
 441           file_mode = (file_mode & ~(S_ISGID | S_IRGRP | S_IWGRP | S_IXGRP))
 442                       | (new_mode & (S_ISGID | S_IRGRP | S_IWGRP | S_IXGRP));
 443         if ((ugo[2] || honor_umask) && !rwxXstugo[8])
 444           file_mode = (file_mode & ~(S_IROTH | S_IWOTH | S_IXOTH))
 445                       | (new_mode & (S_IROTH | S_IWOTH | S_IXOTH));
 446 #ifndef __VXWORKS__
 447         if (is_dir && rwxXstugo[5])
 448           file_mode |= S_ISVTX;
 449         else if (!is_dir)
 450           file_mode &= ~S_ISVTX;
 451 #endif
 452 #endif
 453       }
 454     else if (set_mode == 2)
 455       {
 456         /* Clear '-'.  */
 457         file_mode &= ~new_mode;
 458 #if !defined( __MINGW32__) && !defined (__VXWORKS__)
 459         if (rwxXstugo[5] || !is_dir)
 460           file_mode &= ~S_ISVTX;
 461 #endif
 462       }
 463     else if (set_mode == 3)
 464       {
 465         file_mode |= new_mode;
 466 #if !defined (__MINGW32__) && !defined (__VXWORKS__)
 467         if (rwxXstugo[5] && is_dir)
 468           file_mode |= S_ISVTX;
 469         else if (!is_dir)
 470           file_mode &= ~S_ISVTX;
 471 #endif
 472       }
 473   }
 474
 475   return chmod (file, file_mode);
 476 }
 477
 478
 479 extern int chmod_func (char *, char *, gfc_charlen_type, gfc_charlen_type);
 480 export_proto(chmod_func);
 481
 482 int
 483 chmod_func (char *name, char *mode, gfc_charlen_type name_len,
 484             gfc_charlen_type mode_len)
 485 {
 486   char *cname = fc_strdup (name, name_len);
 487   int ret = chmod_internal (cname, mode, mode_len);
 488   free (cname);
 489   return ret;
 490 }
 491
 492
 493 extern void chmod_i4_sub (char *, char *, GFC_INTEGER_4 *,
 494                           gfc_charlen_type, gfc_charlen_type);
 495 export_proto(chmod_i4_sub);
 496
 497 void
 498 chmod_i4_sub (char *name, char *mode, GFC_INTEGER_4 * status,
 499               gfc_charlen_type name_len, gfc_charlen_type mode_len)
 500 {
 501   int val;
 502
 503   val = chmod_func (name, mode, name_len, mode_len);
 504   if (status)
 505     *status = val;
 506 }
 507
 508
 509 extern void chmod_i8_sub (char *, char *, GFC_INTEGER_8 *,
 510                           gfc_charlen_type, gfc_charlen_type);
 511 export_proto(chmod_i8_sub);
 512
 513 void
 514 chmod_i8_sub (char *name, char *mode, GFC_INTEGER_8 * status,
 515               gfc_charlen_type name_len, gfc_charlen_type mode_len)
 516 {
 517   int val;
 518
 519   val = chmod_func (name, mode, name_len, mode_len);
 520   if (status)
 521     *status = val;
 522 }
 523
 524 #endif