OSDN Git Service

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