libgfortran/intrinsics/chmod.c

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