Setting CHOWN to 0 in perl archive tar - perl

I'm trying to set CHOWN to 0 so that when extracted as root the files aren't chown'd to the uid saved in the archive. This doesn't seem to work.
use Archive::Tar;
use Getopt::Long qw( :config pass_through );
my $tarballName = $ARGV[0];
my $testfix = Archive::Tar->new();
$testfix::CHOWN=0;
$testfix->read ($tarballName);
print "CHOWN=$testfix::CHOWN \n";
$testfix->extract()
The code above prints CHOWN=0, yet when I add print "CHOWN=$CHOWN \n"; to archive::tar.pm and run it I get :
CHOWN=0
CHOWN in tar.pm=1
Is this the correct way to change this setting?

You should set $Archive::Tar::CHOWN, not $testfix::CHOWN. Moreover, you declare $testfix as an object, but later use it as a prefix - these two concepts are quite different!

No. $testfix::CHOWN is the $CHOWN variable in the testfix package, which isn't consulted by anything except your print statement.
$Archive::Tar::CHOWN = 0;

Related

Importing environment variables to Perl

I'm not sure if importing is the right word to use. I'm a beginner in both Perl and Bash. I have set a variable on Bash, so when I do:
echo $PRDIR
it prints a string (It's a directory name)
I want to import that string to Perl, and I don't know how to do that. I've tried:
$varex = system("$PRDIR");
print "$varex";
And also
$varex = system("echo $PRDIR");
print "$varex";
but that doesn't work (I understand the last one, It prints "0" because that's echo's return value). I've also tried redirecting stdout to a variable but I couldn't.
If you want Bash to export a variable into the environment so it's accessible to programs, you can use the export builtin:
export PRDIR
Inside Perl, you would then access it using the %ENV hash:
my $varex = $ENV{"PRDIR"};
print "\$varex is: $varex\n";
Another solution to use the variable directly in perl :
In the shell :
$ export PRDIR=foobar
In perl :
#!/usr/bin/perl
use Modern::Perl;
use Env qw/PRDIR/;
say $PRDIR;
I guess you need something like this:
use Cwd 'abs_path';
use File::Basename;
my $self = abs_path($0);
my $bindir = dirname( abs_path($0) );
unless ($ENV{APP_ENV}) {
warn "No APP_ENV, will try to get from bin/env.sh";
exec("source $bindir/env.sh && /usr/bin/perl $self") || die "$!";
}
I have env.sh in my bin folder with following content:
export APP_ENV=development
The idea behind this approach is that I don't need to bother if I set my ENV variables before running my Perl code or forget to do it. I need just to run my Perl program and it will take care about preparing environment for itself.

Using File::Path to create directory, but owner and group are not set correctly

I'm trying to write a small Perl script which creates a directory structure. To create the directories, I use the standard module File::Path, as follows:
make_path($directory,
{
owner => 'apache',
group => 'apache',
mode => 0500
}
);
When executing the script, the directory is created as wanted and the umask is set as expected, but both owner and group of the file are "root". This is wrong, but where is the error? No error message is printed or given by the error-parameter.
Thanks in advance,
Jost
I just tried it and got the same outcome as you. I looked at the documentation:
perldoc File::Path
...and no mention of 'owner' option. However, searching the latest version (2.08, AFAICT) documentation, and it's there. Can you check the version of the module on your system?
perl -MFile::Path -e 'print $File::Path::VERSION'
If you're not running 2.08, that might be the problem. I'm attempting to track down the changelog for the module right now, but having difficulty...
[ Later ]
OK, so here's what you want to do:
#!/usr/bin/perl -w
use strict;
use File::Path qw( make_path );
my $directory = $ARGV[0];
my $owner = 33;
make_path( $directory, { mode => 0500 } );
chown 33, 33, $directory;
Ultimately, the last line is the one you want to take note of. You can't set the owner when you create it with that version of File::Path, but you can change it. The 33 in my example is the UID of the www-data user on my system; clearly, you want to change 33 to something more sensible for your system. Also, you will need to make sure that your script runs with privileges that are capable of doing this. For example, if you run this as a lowly user, it won't work, but if you run it as root, the chown will work. You might want to find some middle ground there.
I would argue that this is a bug in File::Path; it quietly ignores keys that it doesn't recognize.
#!/usr/bin/perl
use strict;
use warnings;
use File::Path;
print "Using File::Path version $File::Path::VERSION with Perl $]\n";
my $tmpdir = "/tmp/file-path-test-$$";
print "Creating $tmpdir\n";
mkdir $tmpdir, 0777 or die "$tmpdir: $!\n";
my #result = File::Path::make_path
( "$tmpdir/new-dir",
{ owner => 'kst',
mode => 0500,
nosuchkey => 'WTF?' } );
print "Created ( #result )\n";
(Note that this assumes you have an account on your system named "kst"; adjust as needed for your system.)
When I run this under sudo using File::Path version 2.07_03 with Perl 5.010001, the created directory is owned by root; when I do exactly the same thing, but using File::Path version 2.08_01 with Perl 5.014000, the directory is owned by kst. In either case, there's no indication of a problem with the unrecognized keys (owner and nosuchkey for the older version, just nosuchkey for the newer version).
perldoc File::Path doesn't address this issue (unless I missed it), and I don't see any clean way for a program to determine whether the File::Path it's using can handle the newer options. (You could check $File::Path:VERSION, but that requires knowing when a new option was implemented.)
I've just reported this.
Answer by Kenny is useful only when you want to create single directory, not more nested directories - eg. make_path ( 'foo/bar' );
In second case only owner/group of last directory will be changed.
More correct way can be something like this:
#!/usr/bin/perl -w
use strict;
use File::Path qw( make_path );
use File::Spec;
my $directory = $ARGV[0];
my $gid = getgrnam( "my_group" );
my $uid = getpwnam( "my_user" );
make_path( $directory, { mode => 0750 } );
my #directories = File::Spec->splitdir( $directory );
my #path;
foreach my $dir ( #directories ) {
push( #path, $dir );
chown $uid, $gid, File::Spec->catdir( #path );
}

How can I create a directory with the 'right' permissions using Perl's mkdir?

I need help with this program. As a part of my project I need to
create a directory. I was using the system function to do this, but
later was told that Perl has a builtin called mkdir.
I'm on Ubuntu 10.04. The problem is mkdir does not seem to work as needed.
It creates the directory but the permissions are different. Here
is my function that creates the directory:
sub createDir {
my ($dir,$perm) = #_;
unless(-d $dir) {
mkdir $dir,$perm or die "$!";
}
}
and I call it in many parts of my program as:
createDir('.today','0755');
the directory .today gets created but the problem is with permissions,
it does not have the 0755 permission.
What am I doing wrong?
My Perl details are:
$perl -v
This is perl, v5.8.8 built for x86_64-linux-thread-multi
You are passing the permission as a string. mkdir expects it to be numeric. But an octal number inside a string is interpreted as a decimal. So '0755' is being interpreted as decimal 755 and is being used by mkdir.
To fix this you can call the subroutine passing it numeric permission:
createDir('.today',0755);
Alternatively you can use make use of the oct function to convert the octal string into a numeric value.
Subroutine call remains the same:
createDir('.today','0755');
but its definition changes to use the oct function as:
mkdir $dir,oct($perm) or die "$!";
After you fix codeaddict's string versus number issue and note tchrist's umask issue you should call chmod on the new directory after creating it if you need specific permissions.
I usually call mkdir without the mask and then chmod the directory to the permissions I want.
Check these from the shell:
$ perldoc -f mkdir
$ perldoc -f chmod
$ perldoc -f unmask
You can also set the umask to zero before calling mkdir, you'd need to do it this way if you need to create the directory with the correct permissions atomically. Something like this is probably what you're looking for:
sub createDir {
my ($dir, $perm) = #_;
if(!-d $dir) {
my $old = umask(0);
mkdir($dir, $perm) or die "$!";
umask($old);
}
else {
chmod($dir, $perm);
}
}
The second argument to mkdir is not the creation mode. It is a mask which will be &ed with ~umask to determine the creation mode. If you specify an argument of 0755 and your umask is 027, then 0755 &~ 0027 == 0750. Make sure to keep everything in octal, not decimal.
There are also constants for these things available via use POSIX qw[ :sys_stat_h ], such as S_IRWXU, S_IWGRP, and S_ISVTX, but those may be more trouble than they're worth.

How do I automate the initial CPAN configuration?

Here How do I automate CPAN configuration? I've found some answers which led to some questions.
I tried cpan -j config.pm, but as far as I can see it is meant for per installation usage, not for changing the config-file permanently.
With the $CPAN::Config-method the force CPAN::FirstTime to not default to manual-part didn't work here so I tried without it:
#!/usr/bin/perl
use strict;
use warnings;
use Config;
use CPAN;
use CPAN::FirstTime;
$ENV{PERL_MM_USE_DEFAULT}=1;
$ENV{PERL_MM_NONINTERACTIVE}=1;
$ENV{AUTOMATED_TESTING}=1;
my $cpan_home = '/home/me/.cpan';
mkdir $cpan_home or die $! if not -d $cpan_home;
mkdir "$cpan_home/CPAN" or die $! if not -d "$cpan_home/CPAN";
CPAN::FirstTime::init( "$cpan_home/CPAN/MyConfig.pm" );
delete $CPAN::Config->{links};
$CPAN::Config->{applypatch} = '';
# ...
$CPAN::Config->{build_dir} = "$cpan_home/build";
$CPAN::Config->{cpan_home} = $cpan_home;
$CPAN::Config->{histfile} = "$cpan_home/histfile";
$CP$CPAN::Config->{keep_source_where} = "$cpan_home/sources";
$CPAN::Config->{make_install_make_command} = 'sudo make';
$CPAN::Config->{mbuild_install_build_command} = 'sudo ./Build';
$CPAN::Config->{prefs_dir} = "$cpan_home/prefs";
# ...
$CPAN::Config->{yaml_module} = 'YAML';
CPAN::HandleConfig->commit("$cpan_home/CPAN/MyConfig.pm");
CPAN::install('Bundle::CPAN');
# ...
# etc.
exit 0;
Is this OK? The only bad thing that I have noticed so far is the waiting, until the cpan-mirror-urls are found.
And what is the delete $CPAN::Config->{links}; for?
It looks like you are doing a lot of work. What are you trying to accomplish?
If you want to change the configuration file permanently, just change the configuration file. It's Perl code, so I think you can do everything you need, such as setting the root directory, right in the config file without having to deal with CPAN.pm.

How can I create a directory if one doesn't exist using Perl?

Currently, my Perl output is hard-coded to dump into the following Unix directory:
my $stat_dir = "/home/courses/" . **NEED DIR VAR HERE**;
The filename is built as such:
$stat_file = $stat_dir . "/" . $sess.substr($yr, 2, 2) . "_COURSES.csv";
I need a similar approach to building Unix directories, but I need to check if they exist first before creating them.
How can I do auto-numbering (revisions) of the $stat_file so that when these files get pumped into the same directory, they do not overwrite or append to existing files in the directory?
Erm... mkdir $stat_dir unless -d $stat_dir?
It really doesn't seem like a good idea to embed 'extra' questions like that.
Use the -d operator and File::Path.
use File::Path qw(make_path);
eval { make_path($dir) };
if ($#) {
print "Couldn't create $dir: $#";
}
make_path has an advantage over mkdir in that it can create trees of arbitrary depth.
And use -e to check file exists
my $fileSuffix = 0;
while (-e $filename) {
$filename = $filePrefix . ++$fileSuffix . $fileExtension;
}
Remember the directory's -d existence doesn't mean -w writable. But assuming you're in a personal area the mkdir($dir) unless(-d $dir) would work fine.
Perl has a built-in function mkdir
Take a look at perldoc perlfunc or the mkdir program from Perl Power Tools.
I believe it is safe to create a directory that already exists, take a look at the docs.