view release on metacpan or search on metacpan
}
argc -= optind;
argv += optind;
if (!(pw = getpwuid(uid = getuid()))) {
(void)fprintf(stderr, "rsh: unknown user id.\n");
exit(1);
}
if (!user)
user = pw->pw_name;
view release on metacpan or search on metacpan
lib/Git/Deploy/Say.pm view on Meta::CPAN
sub __log {
return if $SKIP_LOGING_DUE_TO_DEEP_RECURSION_WITH_GIT_DEPLOY_DEBUG;
my $str= join("",@_);
my $user = $ENV{USER} || ((getpwuid($<))[0]);
my $pfx= sprintf "# %-12s | %s #",$user,strftime("%Y-%m-%d %H:%M:%S",localtime);
$str=~s/\033\[[^m]+m//g; # strip color
$str=~s/^#([^:]+):/$pfx $1:/mg; # fix prefix
$str=~s/\n*\z/\n/;
if (my $fh= _get_log_handle()) {
view release on metacpan or search on metacpan
src/os/aix/aix_sigar.c view on Meta::CPAN
proccred->uid = pinfo->pi_cred.cr_ruid;
proccred->euid = pinfo->pi_cred.cr_uid;
if (proccred->uid == -1) {
/*
* aix 5.2 has a process named 'jfsz'
* where uid is '-1', getpwuid returns EPERM
*/
proccred->uid = proccred->euid = 0;
}
proccred->gid = pinfo->pi_cred.cr_rgid;
proccred->egid = pinfo->pi_cred.cr_gid;
view release on metacpan or search on metacpan
inc/Module-Build/Module/Build/Platform/Unix.pm view on Meta::CPAN
sub _detildefy {
my ($self, $value) = @_;
$value =~ s[^~([^/]+)?(?=/|$)] # tilde with optional username
[$1 ?
((getpwnam $1)[7] || "~$1") :
($ENV{HOME} || (getpwuid $>)[7])
]ex;
return $value;
}
1;
view release on metacpan or search on metacpan
lib/kateb/LocalData.pm view on Meta::CPAN
#----------------------- GLOBAL VARIABLES -----------------------#
# create empty envs
my $json_file;
# Home directory
my $home_dir = $ENV{HOME} || $ENV{LOGDIR} || (getpwuid $<)[7] || `echo -n ~`;
# Configuration directory
my $config_dir = catdir($ENV{XDG_CONFIG_HOME} || catdir($home_dir, '.config'), $execname);
# download fonts directory
view release on metacpan or search on metacpan
t/lib-restrict.t view on Meta::CPAN
@lib::ORIG_INC = @lib::ORIG_INC; # to avoid warning..
is_deeply(\@lib::ORIG_INC, \@lib::restrict::ORIG_INC, 'name space ORIG_INC');
SKIP: {
skip q{lib::restrict's tests need to be run as root}, $skip if $> != 0;
skip q{Couldn't find valid non-root uid for testing}, $skip if !getpwuid($uuid);
# setup
mkdir $_ for @dirs;
chown $uuid, $uuid, qw(lib_restrict_array_ok_y lib_restrict_array_bad_y lib_restrict_user);
no warnings 'uninitialized'; # $INC{1} is uninit @ times below
view release on metacpan or search on metacpan
lib/Net/Config.pm view on Meta::CPAN
%NetConfig = (%NetConfig, %{$ref});
$LIBNET_CFG = $file;
}
}
if ($< == $> and !$CONFIGURE) {
my $home = eval { local $SIG{__DIE__}; (getpwuid($>))[7] } || $ENV{HOME};
$home ||= $ENV{HOMEDRIVE} . ($ENV{HOMEPATH} || '') if defined $ENV{HOMEDRIVE};
if (defined $home) {
$file = $home . "/.libnetrc";
$ref = eval { local $SIG{__DIE__}; do $file } if -f $file;
%NetConfig = (%NetConfig, %{$ref})
view release on metacpan or search on metacpan
Mpp/BuildCacheControl.pm view on Meta::CPAN
$sep = "MODE EL ${grtitle}UID BI-UID SIZE ${timetype}D ${timetype}DATE ${timetype}TIME MEMBER\n"
unless $Mpp::verbose;
groupfind {
return if $deletable && ($combined_lstat[EXTLINK] && defined $combined_lstat[BIUID])
or defined $pattern && !/$pattern/;
$_ = defined() ? $user{$_} ||= getpwuid( $_ ) || $_ : '-'
for @combined_lstat[UID, BIUID];
if( defined $sep ) {
print $sep;
undef $sep;
}
Mpp/BuildCacheControl.pm view on Meta::CPAN
if( $Mpp::verbose > 1 ) { # Show each individual member.
for( my $i = 0; $i < @lstats; $i++ ) {
next unless defined $lstats[$i];
my $file = "$_[0][$i]/$_";
if( ref $lstats[$i] ) { # Normal file
$_ = defined() ? $user{$_} ||= getpwuid( $_ ) || $_ : '-'
for @{$lstats[$i]}[UID, BIUID];
showfull $lstats[$i], $file, $time;
} else {
print "$file -> " . readlink( $file ) . "\n";
}
view release on metacpan or search on metacpan
Sjis/0.93 2013-12-29 00:00:00
- fix quoting after filetest operators
- Esjis::unlink() deletes read only file too
- remove PERL5.BATes
- remove strict.pm_, warnings.pm_, warnings/register.pm_, and feature.pm_
- truncate(), getpwnam(), and getpwuid() into eval q{}
- consider Win95Cmd.exe by PERL5SHELL
- remove $ENV{'COMSPEC'}
- changed condition for escaping script
- support ActivePerl 5.18.1.1800 Windows (x86)
- support ActivePerl 5.18.1.1800 Windows (64-bit, x64)
view release on metacpan or search on metacpan
&::enum
($::TBCTL_INIT=0, $::TBCTL_ROW, $::TBCTL_COL, $::TBCTL_END,
$::TBCTL_HEAD);
# Provide defaults
local (@pw) = getpwuid ($<);
($::headers[$::HDR_MHID] = $ENV{"MMDS_ID"}
|| $cfg->gps("general.id", $pw[0])) =~ tr/[a-z]/[A-Z]/;
$::headers[$::HDR_AUTHOR] = $::headers[$::HDR_FROM] =
$ENV{"MMDS_FULLNAME"} || $ENV{"FULLNAME"}
|| $cfg->gps("general.author", $pw[6]);
local($[) = 0;
if ( $path =~ m|^~/| ) {
setpwent;
if ( defined ($home = $ENV{'HOME'} || $ENV{'LOGDIR'}
|| (getpwuid($>))[7]) ) {
$path = $home . '/' . $';
}
}
elsif ( $path =~ m|^~([^/]+)/| ) {
setpwent;
view release on metacpan or search on metacpan
lib/MMM/Utils.pm view on Meta::CPAN
if ($user
&& ($> == 0 || $< == 0)) { # if we're not root, we can only ignore this
if ($user =~ /^\d+$/) {
$uid = $user;
my @uinfo = POSIX::getpwuid($uid);
if (!scalar(@uinfo)) {
return(undef, sprintf('User %s don\'t exists', $uid));
}
$gid = $uinfo[3];
} else {
view release on metacpan or search on metacpan
Apache-Test/lib/Apache/TestConfig.pm view on Meta::CPAN
sub default_user {
return if WINFU;
my $uid = $>;
my $user = $ENV{APACHE_TEST_USER} || (getpwuid($uid) || "#$uid");
if ($user eq 'root') {
my $other = (getpwnam('nobody'))[0];
if ($other) {
$user = $other;
view release on metacpan or search on metacpan
);
# these are not customizable at runtime!
$hardparams = "(readonly|maxlen|dbdriver|useencryption|cryptmethod)";
$CONF = File::Spec->catfile($ENV{HOME}, ".noterc");
$USER = getlogin || getpwuid($<); chomp $USER;
$TOPIC = 1;
$VERSION = "1.4.2";
$CurDepth = 1; # the current depth inside the topic "directory" structure...
$maxlen = "auto";
$timelen = 22;
view release on metacpan or search on metacpan
sub get_username
{
unless (&is_win32())
{
return ( getpwuid $< ) [0];
}
return "user";
}
view release on metacpan or search on metacpan
lib/oEdtk/Config.pm view on Meta::CPAN
# Get the DEFAULT and ENVDESC sections by default, override with the optional
# sections that we were given, and finally with the hostname section.
my %cfg = ();
$cfg{'EDTK_HOST'} = $uchost;
$cfg{'USERNAME'} = getlogin || getpwuid($<) || "undef";
foreach ('DEFAULT', 'ENVDESC', @$sections, $uchost) {
if (exists $allcfg{$_}) {
%cfg = ( %cfg, %{$allcfg{$_}} );
}
}
view release on metacpan or search on metacpan
lib/Poros/Query.pm view on Meta::CPAN
die "invalid code\n" unless
-f ( $code = File::Spec->join( $path{code}, $code ) )
&& ( $code = do $code ) && ref $code eq 'CODE';
if ( ! $< && $user && $user ne ( getpwuid $< )[0] )
{
die "invalid user $user\n" unless my @pw = getpwnam $user;
@pw = map { 0 + sprintf '%d', $_ } @pw[2,3];
POSIX::setgid( $pw[1] ); ## setgid must preceed setuid
POSIX::setuid( $pw[0] );
view release on metacpan or search on metacpan
lib/perfSONAR_PS/OWP.pm view on Meta::CPAN
or die "Can't getpwnam($unam): $!";
}
elsif ( $uid < 0 ) {
$uid = -$uid;
}
die("Invalid UID: $uid") if ( !getpwuid($uid) );
$> = $< = $uid;
return;
}
view release on metacpan or search on metacpan
cpan/Archive-Tar/lib/Archive/Tar/Constant.pm view on Meta::CPAN
use constant READ_ONLY => sub { shift() ? 'rb' : 'r' };
use constant WRITE_ONLY => sub { $_[0] ? 'wb' . shift : 'w' };
use constant MODE_READ => sub { $_[0] =~ /^r/ ? 1 : 0 };
# Pointless assignment to make -w shut up
my $getpwuid; $getpwuid = 'unknown' unless eval { my $f = getpwuid (0); };
my $getgrgid; $getgrgid = 'unknown' unless eval { my $f = getgrgid (0); };
use constant UNAME => sub { $getpwuid || scalar getpwuid( shift() ) || '' };
use constant GNAME => sub { $getgrgid || scalar getgrgid( shift() ) || '' };
use constant UID => $>;
use constant GID => (split ' ', $) )[0];
use constant MODE => do { 0666 & (0777 & ~umask) };
view release on metacpan or search on metacpan
"C:${SL}system${SL}temp");
unshift(@TEMP,$ENV{'TMPDIR'}) if defined $ENV{'TMPDIR'};
# this feature was supposed to provide per-user tmpfiles, but
# it is problematic.
# unshift(@TEMP,(getpwuid($<))[7].'/tmp') if $CGI::OS eq 'UNIX';
# Rob: getpwuid() is unfortunately UNIX specific. On brain dead OS'es this
# : can generate a 'getpwuid() not implemented' exception, even though
# : it's never called. Found under DOS/Win with the DJGPP perl port.
# : Refer to getpwuid() only at run-time if we're fortunate and have UNIX.
# unshift(@TEMP,(eval {(getpwuid($>))[7]}).'/tmp') if $CGI::OS eq 'UNIX' and $> != 0;
foreach (@TEMP) {
do {$TMPDIRECTORY = $_; last} if -d $_ && -w _;
}
}
view release on metacpan or search on metacpan
benchmarks/app/perlfunc.pod view on Meta::CPAN
=item Fetching user and group info
C<endgrent>, C<endhostent>, C<endnetent>, C<endpwent>, C<getgrent>,
C<getgrgid>, C<getgrnam>, C<getlogin>, C<getpwent>, C<getpwnam>,
C<getpwuid>, C<setgrent>, C<setpwent>
=item Fetching network info
C<endprotoent>, C<endservent>, C<gethostbyaddr>, C<gethostbyname>,
C<gethostent>, C<getnetbyaddr>, C<getnetbyname>, C<getnetent>,
benchmarks/app/perlfunc.pod view on Meta::CPAN
C<dbmclose>, C<dbmopen>, C<dump>, C<endgrent>, C<endhostent>,
C<endnetent>, C<endprotoent>, C<endpwent>, C<endservent>, C<exec>,
C<fcntl>, C<flock>, C<fork>, C<getgrent>, C<getgrgid>, C<gethostbyname>,
C<gethostent>, C<getlogin>, C<getnetbyaddr>, C<getnetbyname>, C<getnetent>,
C<getppid>, C<getpgrp>, C<getpriority>, C<getprotobynumber>,
C<getprotoent>, C<getpwent>, C<getpwnam>, C<getpwuid>,
C<getservbyport>, C<getservent>, C<getsockopt>, C<glob>, C<ioctl>,
C<kill>, C<link>, C<lstat>, C<msgctl>, C<msgget>, C<msgrcv>,
C<msgsnd>, C<open>, C<pipe>, C<readlink>, C<rename>, C<select>, C<semctl>,
C<semget>, C<semop>, C<setgrent>, C<sethostent>, C<setnetent>,
C<setpgrp>, C<setpriority>, C<setprotoent>, C<setpwent>,
benchmarks/app/perlfunc.pod view on Meta::CPAN
restrict what salts C<crypt()> accepts.
Here's an example that makes sure that whoever runs this program knows
their password:
$pwd = (getpwuid($<))[1];
system "stty -echo";
print "Password: ";
chomp($word = <STDIN>);
print "\n";
benchmarks/app/perlfunc.pod view on Meta::CPAN
=item getlogin
This implements the C library function of the same name, which on most
systems returns the current login from F</etc/utmp>, if any. If null,
use C<getpwuid>.
$login = getlogin || getpwuid($<) || "Kilroy";
Do not consider C<getlogin> for authentication: it is not as
secure as C<getpwuid>.
=item getpeername SOCKET
Returns the packed sockaddr address of other end of the SOCKET connection.
benchmarks/app/perlfunc.pod view on Meta::CPAN
=item getnetbyname NAME
=item getprotobyname NAME
=item getpwuid UID
=item getgrgid GID
=item getservbyname NAME,PROTO
benchmarks/app/perlfunc.pod view on Meta::CPAN
In scalar context, you get the name, unless the function was a
lookup by name, in which case you get the other thing, whatever it is.
(If the entry doesn't exist you get the undefined value.) For example:
$uid = getpwnam($name);
$name = getpwuid($num);
$name = getpwent();
$gid = getgrnam($name);
$name = getgrgid($num);
$name = getgrent();
#etc.
view release on metacpan or search on metacpan
lib/perlfaq3.pod view on Meta::CPAN
# make file a month younger than today, defeating reaper daemons
perl -e '$X=24*60*60; utime(time(),time() + 30 * $X,@ARGV)' *
# find first unused uid
perl -le '$i++ while getpwuid($i); print $i'
# display reasonable manpath
echo $PATH | perl -nl -072 -e '
s![^/+]*$!man!&&-d&&!$s{$_}++&&push@m,$_;END{print"@m"}'
view release on metacpan or search on metacpan
lib/perlrc.pm view on Meta::CPAN
sub _home {
my $user = shift;
my $uid = (length $user ? getpwnam($user) : $>);
defined $uid or return "~$user";
my $home = (getpwuid $uid)[7];
defined $home or return "~$user";
$home
}
sub import {
view release on metacpan or search on metacpan
}
# Use system mailbox if none was specified on the command line
if ( $#ARGV < 0 ) {
if ( ! ($user = getlogin)) {
@a = getpwuid($<);
$user = $a[0];
}
if ( -r "/var/spool/mail/$user" ) { # Modern systems
@ARGV = ("/var/spool/mail/$user");
}
view release on metacpan or search on metacpan
lib/Psh/Completion.pm view on Meta::CPAN
msgctl msgget msgrcv msgsnd semctl semget
semop shmctl shmget shmread shmwrite
endgrent endhostent endnetent endpwent getgrent
getgrgid getgrnam getlogin getpwent getpwnam
getpwuid setgrent setpwent
endprotoent endservent gethostbyaddr
gethostbyname gethostent getnetbyaddr
getnetbyname getnetent getprotobyname
getprotobynumber getprotoent getservbyname
view release on metacpan or search on metacpan
GETPWENT_R_PROTO|5.008000|5.008000|Vn
getpwnam|5.009000||Viu
GETPWNAM_R_HAS_BUFFER|5.008000||Viu
GETPWNAM_R_HAS_PTR|5.008000||Viu
GETPWNAM_R_PROTO|5.008000|5.008000|Vn
getpwuid|5.009000||Viu
GETPWUID_R_HAS_PTR|5.008000||Viu
GETPWUID_R_PROTO|5.008000|5.008000|Vn
get_quantifier_value|5.033006||Viu
get_re_arg|||xciu
get_re_gclass_nonbitmap_data|5.031011||Viu
KEY_getprotobyname|5.003007||Viu
KEY_getprotobynumber|5.003007||Viu
KEY_getprotoent|5.003007||Viu
KEY_getpwent|5.003007||Viu
KEY_getpwnam|5.003007||Viu
KEY_getpwuid|5.003007||Viu
KEY_getservbyname|5.003007||Viu
KEY_getservbyport|5.003007||Viu
KEY_getservent|5.003007||Viu
KEY_getsockname|5.003007||Viu
KEY_getsockopt|5.003007||Viu
view release on metacpan or search on metacpan
Autodoc/dev_rls_tool_doc.html view on Meta::CPAN
#
# Save ourselves some repeated primitive operations by caching them here:
#
$opts{date} = scalar localtime;
$opts{user} = $ENV{LOGNAME} || (getpwuid($>))[0] || getlogin;
$opts{wmpassword} = $ENV{WMPASSWD} || '';
#
# Set up more extensive die()- and warn()-handlers
#
Autodoc/dev_rls_tool_doc.html view on Meta::CPAN
if (defined $CONFIG{ACL_DIR})
{
if ($CONFIG{ACL_DIR} !~ m|^/|)
{
my $homedir = ($CONFIG{OWNER} =~ /^\d+$/) ?
(getpwuid($CONFIG{OWNER}))[7] :
(getpwnam($CONFIG{OWNER}))[7];
$CONFIG{ACL_DIR} = "$homedir/$CONFIG{ACL_DIR}";
}
Autodoc/dev_rls_tool_doc.html view on Meta::CPAN
my $prefix = $CONFIG{HALTFILE_PREFIX};
unless (defined $prefix and $prefix)
{
my $home = ($CONFIG{OWNER} =~ /^\d+$/o) ?
(getpwuid($CONFIG{OWNER}))[7] : (getpwnam($CONFIG{OWNER}))[7];
unless (defined $home and $home)
{
warn "$cmd: test_for_halt: Could not find haltfiles area, " .
"skipping\n";
return 0;
Autodoc/dev_rls_tool_doc.html view on Meta::CPAN
$prefix = "$home/etc/halt-";
}
if (! $prefix =~ m|^/|o)
{
my $home = ($CONFIG{OWNER} =~ /^\d+$/o) ?
(getpwuid($CONFIG{OWNER}))[7] : (getpwnam($CONFIG{OWNER}))[7];
unless (defined $home and $home)
{
warn "$cmd: test_for_halt: Could not find haltfiles area, " .
"skipping\n";
return 0;
view release on metacpan or search on metacpan
savevars.pm view on Meta::CPAN
}
sub cfgfile {
if (!defined $cfgfile) {
my $basename = ($0 =~ m|([^/\\]+)$| ? $1 : $0);
$cfgfile = eval { (getpwuid($<))[7] } || $ENV{'HOME'} || '';
if ($cfgfile eq '' && $^O eq 'MSWin32') {
$cfgfile = 'C:';
}
$cfgfile .= "/.${basename}rc";
}
savevars.pm view on Meta::CPAN
cfgfile() uses the $< variable to determine the current home
directory. This might not be what you want if using setuid scripts.
=head1 BUGS
Because getpwuid() is used, this module will not work very well on
Windows. Configuration files will be stored in the current drive root
directory or, if the C<$HOME> environment variable exists, in the
C<$HOME> directory.
=head1 AUTHOR
view release on metacpan or search on metacpan
perllib/sdf/home/stdlib/langdefs.sdm view on Meta::CPAN
getgrent getgrgid getgrnam gethostbyaddr \
gethostbyname gethostent getlogin \
getnetbyaddr getnetbyname getnetent \
getpeername getpgrp getppid getpriority \
getprotobyname getprotobynumber getprotoent \
getpwent getpwnam getpwuid getservbyname \
getservbyport getservent getsockname \
getsockopt glob gmtime gt hex index int \
ioctl join kill lc lcfirst le length \
link listen localtime log lstat lt \
mkdir msgctl msgget msgrcv msgsnd ne \
view release on metacpan or search on metacpan
lib/App/SmokeBrew/Plugin/CPANPLUS/YACSmoke.pm view on Meta::CPAN
use vars qw[@RUN_TIME_INC $LIB_DIR $BUNDLE_DIR $BASE $PRIV_LIB];
$LIB_DIR = File::Spec->catdir( $FindBin::Bin, qw[.. lib] );
$BUNDLE_DIR = File::Spec->catdir( $FindBin::Bin, qw[.. inc bundle] );
my $who = getlogin || getpwuid($<) || $<;
$BASE = File::Spec->catfile(
$FindBin::Bin, '..', '.cpanplus', $who);
$PRIV_LIB = File::Spec->catfile( $BASE, 'lib' );
@RUN_TIME_INC = ($PRIV_LIB, @INC);