view release on metacpan or search on metacpan
bin/realtimed view on Meta::CPAN
info "detected current realtimed absolute path as: $myfullpath";
info "detected program name as: $programname";
my $euid = geteuid;
my $uid = getuid;
my $user = getpwuid($uid);
my $euser = getpwuid($euid);
my $rootuser = getpwuid(0);
unless ($euid == $uid){
my $msg = "you ($user) are executing this program with setuid to $euser credentials, exiting";
emerg $msg;
say $msg;
view release on metacpan or search on metacpan
lib/List/Gen/Lazy/Builtins.pm view on Meta::CPAN
default defined die do endgrent endhostent endnetent endprotoent
endpwent endservent eof eval exec exit exp fcntl fileno flock fork
formline getc 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 goto hex index int ioctl join
kill lc lcfirst length link listen localtime lock log lstat mkdir
msgctl msgget msgrcv msgsnd oct open opendir ord pack pipe pop pos
print printf prototype push quotemeta rand read readdir readline
readlink readpipe recv ref rename require reset reverse rewinddir
lib/List/Gen/Lazy/Builtins.pm view on Meta::CPAN
chown chr chroot close closedir connect cos crypt dbmclose dbmopen default
defined die do endgrent endhostent endnetent endprotoent endpwent
endservent eof eval exec exit exp fcntl fileno flock fork formline getc
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
goto hex index int ioctl join keys kill lc lcfirst length link listen
localtime lock log lstat mkdir msgctl msgget msgrcv msgsnd oct open opendir
ord pack pipe pop pos print printf prototype push quotemeta rand read
readdir readline readlink readpipe recv ref rename require reset reverse
view release on metacpan or search on metacpan
Agent/Driver/Mail.pm view on Meta::CPAN
# make -- driver constructor
#
sub make {
my $self = bless {
prefix => '',
to => (getpwuid $<)[0],
cc => '',
bcc => '',
subject => '',
from => '',
priority => '',
view release on metacpan or search on metacpan
lib/Log/Fine/Formatter/Template.pm view on Meta::CPAN
return $self->{_userName};
} elsif ($self->{use_effective_id}) {
$self->{_userName} =
($^O eq "MSWin32")
? $ENV{EUID} || 0
: getpwuid($>) || "nobody";
} else {
$self->{_userName} = getlogin() || getpwuid($<) || "nobody";
}
return $self->{_userName};
} # _userName()
view release on metacpan or search on metacpan
lib/Log/Handler/Pattern.pm view on Meta::CPAN
sub _get_c_pkg { (caller(2+$Log::Handler::CALLER_LEVEL))[0] }
sub _get_c_file { (caller(2+$Log::Handler::CALLER_LEVEL))[1] }
sub _get_c_line { (caller(2+$Log::Handler::CALLER_LEVEL))[2] }
sub _get_c_sub { (caller(3+$Log::Handler::CALLER_LEVEL))[3]||"" }
sub _get_runtime { return sprintf('%.6f', Time::HiRes::gettimeofday - START_TIME) }
sub _get_user { getpwuid($<) || $< }
sub _get_group { getgrgid($(+0) || $(+0 }
sub _get_hires {
my $self = shift;
if (!$self->{timeofday}) {
view release on metacpan or search on metacpan
lib/Log/Log4perl/Appender/SMTP.pm view on Meta::CPAN
sub new {
my($class, @options) = @_;
my $hname = hostfqdn() || '<unknown>';
my $user = getlogin || getpwuid($<) || 'log4perl';
return bless {
from => $user.'@'.$hname,
to => 'postmaster',
subject => "Subject: Log4perl from $hname\n",
view release on metacpan or search on metacpan
lib/Log/Log4perl.pm view on Meta::CPAN
my $config = <<'END';
log4perl.logger = INFO, Main
log4perl.appender.Main = Log::Log4perl::Appender::File
log4perl.appender.Main.filename = \
sub { "example" . getpwuid($<) . ".log" }
log4perl.appender.Main.layout = Log::Log4perl::Layout::SimpleLayout
END
$Log::Log4perl::Config->allow_code('restrictive');
Log::Log4perl->init( \$config ); # will fail
$Log::Log4perl::Config->allow_code('safe');
Log::Log4perl->init( \$config ); # will succeed
The reason that the first call to -E<gt>init() fails is because the
'restrictive' name maps to an opcode mask of ':default'. getpwuid() is not
part of ':default', so -E<gt>init() fails. The 'safe' name maps to an opcode
mask of ':browse', which allows getpwuid() to run, so -E<gt>init() succeeds.
allowed_code_ops_convenience_map() can be invoked in several ways:
=over 4
view release on metacpan or search on metacpan
lib/Log/ProgramInfo.pm view on Meta::CPAN
BEGIN {
$progbase = $FindBin::Script;
$starttime = DateTime->from_epoch(epoch => time);
$valid_dates{$_} = 1 for qw( date time datetime none );
$uid = getpwuid $<;
my $euid = getpwuid $>;
$gid = groupmap $(;
my $egid = groupmap $);
$uid = "$euid($uid)" if $uid ne $euid;
$gid = "$egid // $gid" if $egid ne $gid;
view release on metacpan or search on metacpan
devel/bin/smoke.pl view on Meta::CPAN
my $config = {
src => canonpath( catdir( $FindBin::Bin, '../../' ) ),
verbose => 0,
email_to => undef,
email_from => getpwuid($<) . '@' . hostname(),
email_subject => 'Lucy Smoke Test Report ' . localtime(),
mailhost => 'localhost',
test_target => 'test', # could also be 'test_valgrind' if on Linux
};
view release on metacpan or search on metacpan
SoundFont.pm view on Meta::CPAN
return %sf;
}
sub new_sf { my $inam = $_[$[] || 'Name of this SoundFont';
my ($name,$passwd,$uid,$gid, $quota,$comment,$gcos,$dir,$shell,$expire)
= getpwuid($>);
$gcos =~ s/,+$//;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
my $y = sprintf ("%4.4d", $year+1900);
my @abbr = qw( January February March April May June
July August September October November December );
view release on metacpan or search on metacpan
bin/scripts/moby-s-caching.pl view on Meta::CPAN
sub check_root {
# assume that windows has no security preventing the copying of files
return if (MSWIN);
unless ( getpwuid($<) eq 'root' ) {
print STDOUT <<EOT;
Hmmm - you are not running this as root. If you indicate any
system directories for the installation, such as '/usr/local/apache/', then
you may not have permission to install files there. If so, you should
view release on metacpan or search on metacpan
bin/fetch_pods.PLS view on Meta::CPAN
1;
}
sub find_config_file {
my $self = shift;
my $home = (getpwuid($<))[7] || $ENV{HOME};
my @paths = ("$home/.fetchpods",
"/usr/local/etc/fetchpods.conf",
"/usr/etc/fetchpods.conf",
"/etc/fetchpods.conf",
"$Bin/../etc/fetchpods.conf",
bin/fetch_pods.PLS view on Meta::CPAN
}
sub interpolate {
my $ref = shift;
return unless defined $ref;
$ref =~ s/^~([^\/]*)/($1 ? getpwnam($1):getpwuid($<))[7] || "~$1"/eg;
$ref =~ s/\$(\w+)/$ENV{$1}/g;
$ref;
}
__END__
view release on metacpan or search on metacpan
examples/request-reply/request_permdyn.pl view on Meta::CPAN
#
# The dynamic queue name contains the userid. For real applications,
# you'd use an application instance specific name, whether that's the
# host, the product, the tarde engine, or whatever.
#
my $userid = ($^O =~ /^MSWin/ ? $ENV{USERNAME} : getpwuid($<));
my $reply_qname = $dynamic_qname;
$reply_qname =~ s/\.\*$/.\U$userid/;
print "Have dynamic reply queue name [$reply_qname]\n";
my $reply_queue = MQSeries::Queue::->
view release on metacpan or search on metacpan
lib/MYDan/Agent/Query.pm view on Meta::CPAN
my ( $code, $sudo, $env ) = @$query{ qw( code sudo env ) };
idie( "already running $code\n" ) if ( $code =~ /\.mx$/ ) && !
MYDan::Util::ProcLock->new( File::Spec->join( $path{run}, $code ) )->lock();
if ( $code ne 'proxy' && ! $< && $sudo && $sudo ne ( getpwuid $< )[0] )
{
idie( "invalid sudo $sudo\n" ) unless my @pw = getpwnam $sudo;
@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
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
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
my $dpath = $Dst . $k;
unless ($opt_n){
copyattrib($spath, $dpath, $mode, $uid, $gid, $atime, $mtime);
$opt_v and do_log(sprintf "0%04o,%s,%s $dpath", ($mode & 07777),
(getpwuid($uid))[0],(getgrgid($gid))[0] );
}
}
if ($opt_r >= 2){
# these are to make DB operation fast enough
view release on metacpan or search on metacpan
0.04 2015-09-01T07:17:52+0200
- Fix "Calling a synchronous function on an asynchronous handle"
Cannot change $db into async mode if already in sync mode
0.03 2015-07-12T11:36:05+0200
- Fix "The getpwuid function is unimplemented"
0.02 2015-04-22T08:27:17+0200
- More robust live database tests
0.01 2015-04-20T20:44:10+0200
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
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
lib/Mail/Audit.pm view on Meta::CPAN
'Maildir'
);
$default_mbox =
(-d File::Spec->catdir($default_maildir, 'new') ? $default_maildir : ())
|| ((grep { -d $_ } qw(/var/spool/mail/ /var/mail/))[0] . getpwuid($>));
return $self->{_default_mbox} = $default_mbox;
}
# XXX: This is a test case until I have a better interface. This will make
view release on metacpan or search on metacpan
%options,
};
# Guess the 'from' address
if(! exists $self->{from}) {
my $user = scalar getpwuid($<);
my $domain = domain();
$self->{from} = "$user\@$domain";
}
# Guess the 'date'
view release on metacpan or search on metacpan
lib/Mail/Decency/ContentFilter/CRM114.pm view on Meta::CPAN
my ( $user, $domain ) = split( /@/, $self->to, 2 );
return unless $user;
my $uid = getpwnam( $user );
return unless $uid;
$user = ( getpwuid( $uid ) )[-2];
$user .= "/.crm114";
return $user;
}
view release on metacpan or search on metacpan
lib/Mail/LocalDelivery.pm view on Meta::CPAN
} else {
croak
"Data was neither a mail object or a reference to something I understand";
}
my $default_maildir = ((getpwuid($>))[7]) . "/Maildir/";
my $default_mbox = $ENV{MAIL}
|| (-d File::Spec->catdir($default_maildir, 'new') ? $default_maildir : ())
|| ((grep { -d $_ } qw(/var/spool/mail/ /var/mail/))[0] . getpwuid($>));
$self->{default_mbox} = $default_mbox;
$self->{emergency} ||= $default_mbox;
return bless $self => $class;
lib/Mail/LocalDelivery.pm view on Meta::CPAN
POSIX->import(qw(strftime));
@out = map { strftime($_, @localtime) } @out;
}
@out = map {
s{^~/} {((getpwuid($>))[7])."/"}e;
s{^~(\w+)/}{((getpwnam($1))[7])."/"}e;
$_
} @out;
return @out;
view release on metacpan or search on metacpan
examples/filter.pl view on Meta::CPAN
use 5.005;
my $TMPDIR = $ENV{TMPDIR} || $ENV{TEMP} || '/usr/tmp';
# The default mailbox for delivery.
my $default = "/var/spool/mail/".getpwuid($>);
# A pattern to break out words in email names.
my $wordpat = qr/[-a-zA-Z0-9_.]+/;
my $wordpat_nodot = qr/[-a-zA-Z0-9_]+/;
view release on metacpan or search on metacpan
? delete $mail_ref->{'_html_info'} : {};
delete $mail_ref->{'_html_info'} if exists $mail_ref->{'_html_info'};
delete $html_info->{$_} for qw(ctype disposition msg);
my $time = time;
my $user = $^O eq 'MSWin32' ? "(Windows: $<)" : getpwuid($<);
my $eusr = $^O eq 'MSWin32' ? "(Windows: $>)" : getpwuid($>);
my $file = File::Spec->rel2abs($0);
my $host = $hostname_code->();
my @siteheaders = (
qq{X-Mailer: use SimpleMood; - Sent via the email() function or easy() method of Mail/Sender/Easy.pm and/or SimpleMood.pm both by Daniel Muey.},
view release on metacpan or search on metacpan
lib/Mail/Sender.pm view on Meta::CPAN
{
my $username;
sub getusername () {
return $username if defined($username);
return $username = eval { getlogin || getpwuid($<) } || $ENV{USERNAME};
}
}
#IO
view release on metacpan or search on metacpan
lib/Mail/SpamAssassin.pm view on Meta::CPAN
# Make sure that we clean $PATH if we're tainted
Mail::SpamAssassin::Util::clean_path_in_taint_mode();
if (!defined $self->{username}) {
$self->{username} = (Mail::SpamAssassin::Util::portable_getpwuid ($>))[0];
}
$self->create_locker();
$self;
lib/Mail/SpamAssassin.pm view on Meta::CPAN
my $home;
if (am_running_on_windows()) {
# Windows has a special folder for common appdata (Bug 8050)
$home = Mail::SpamAssassin::Util::common_application_data_directory();
} else {
$home = (Mail::SpamAssassin::Util::portable_getpwuid ($>))[7];
}
if ($home && $home ne $helper_dir) {
my $dir = File::Spec->catdir($home, ".spamassassin");
return if $self->test_global_state_dir($dir);
}
lib/Mail/SpamAssassin.pm view on Meta::CPAN
return '';
} else {
return $home if ($home && index($home, '/') != -1);
return (getpwnam($name))[7] if ($name ne '');
return (getpwuid($>))[7];
}
}
sub sed_path {
my ($self, $path) = @_;
view release on metacpan or search on metacpan
lib/Mail/SpamCannibal/SMTPsend.pm view on Meta::CPAN
sub sendmessage {
my ($message,$to,$from,$fh) = @_;
$to .= '@' . fqdn()
unless $to =~ /\@/;
unless ($from) {
$from = (getpwuid($<))[0] .'@'. fqdn();
} elsif( $from !~ /\@/) {
$from .= '@' . fqdn();
}
my $head = 'To: '. $to ."\nFrom: ". $from ."\n";
my @mxhosts = getMXhosts($to);
view release on metacpan or search on metacpan
bin/dspam-train view on Meta::CPAN
my $Usage = "Usage: $myname [spam|ok] [file]\n";
# Check one or more arguments:
die $Usage if ($#ARGV < 0);
my $HOME = $ENV{'HOME'} || $ENV{'LOGDIR'} ||
(getpwuid($<))[7] || die "You're homeless!\n";
my $USER = $ENV{'USER'} || getlogin ||
(getpwuid($<))[0] || die "You're nameless!\n";
my $opts = "--user $USER --mode=teft --stdout";
my $V = 0;
if (@ARGV && $ARGV[0] eq "-v") {