Home | History | Annotate | Line # | Download | only in util
      1  1.1.1.2  christos #! /usr/bin/env perl
      2  1.1.1.3  christos # Copyright 1999-2021 The OpenSSL Project Authors. All Rights Reserved.
      3  1.1.1.2  christos #
      4  1.1.1.4  christos # Licensed under the Apache License 2.0 (the "License").  You may not use
      5  1.1.1.2  christos # this file except in compliance with the License.  You can obtain a copy
      6  1.1.1.2  christos # in the file LICENSE in the source distribution or at
      7  1.1.1.2  christos # https://www.openssl.org/source/license.html
      8      1.1  christos 
      9      1.1  christos # On some systems, the -p option to mkdir (= also create any missing parent
     10      1.1  christos # directories) is not available.
     11      1.1  christos 
     12      1.1  christos my $arg;
     13      1.1  christos 
     14      1.1  christos foreach $arg (@ARGV) {
     15      1.1  christos   $arg =~ tr|\\|/|;
     16      1.1  christos   &do_mkdir_p($arg);
     17      1.1  christos }
     18      1.1  christos 
     19      1.1  christos 
     20      1.1  christos sub do_mkdir_p {
     21      1.1  christos   local($dir) = @_;
     22      1.1  christos 
     23      1.1  christos   $dir =~ s|/*\Z(?!\n)||s;
     24      1.1  christos 
     25      1.1  christos   if (-d $dir) {
     26      1.1  christos     return;
     27      1.1  christos   }
     28      1.1  christos 
     29      1.1  christos   if ($dir =~ m|[^/]/|s) {
     30      1.1  christos     local($parent) = $dir;
     31      1.1  christos     $parent =~ s|[^/]*\Z(?!\n)||s;
     32      1.1  christos 
     33      1.1  christos     do_mkdir_p($parent);
     34      1.1  christos   }
     35      1.1  christos 
     36  1.1.1.2  christos   unless (mkdir($dir, 0777)) {
     37  1.1.1.3  christos     local($err) = $!;
     38  1.1.1.2  christos     if (-d $dir) {
     39  1.1.1.2  christos       # We raced against another instance doing the same thing.
     40  1.1.1.2  christos       return;
     41  1.1.1.2  christos     }
     42  1.1.1.3  christos     die "Cannot create directory $dir: $err\n";
     43  1.1.1.2  christos   }
     44      1.1  christos   print "created directory `$dir'\n";
     45      1.1  christos }
     46