libgfortran/intrinsics/chmod.c

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