view release on metacpan or  search on metacpan

example/SampleConfig.pm  view on Meta::CPAN

   ## Paths and URLs
   #  Where to find files
   $config{'basedir'}      = "/home/web/myApp";
   $config{'templatedir'}  = "$config{basedir}/tmpls";
   $config{'cgidir'}       = "$config{basedir}/cgi";
   $config{'htmldir'}      = "$config{basedir}/html";
   $config{'libdir'}       = "$config{basedir}/lib";
   $config{'sqldir'}       = "$config{libdir}/sql";

   #  Where to find links

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

get_cvs|5.011000|5.003007|p
getcwd_sv|5.007002|5.007002|
get_db_sub|||iu
get_debug_opts|5.008001||Viu
get_deprecated_property_msg|5.031010||cVniu
getegid|5.005000||Viu
getenv|5.005000||Viu
getenv_len|5.006000||Viu
geteuid|5.005000||Viu
getgid|5.005000||Viu
getgrent|5.009000||Viu
GETGRENT_R_HAS_BUFFER|5.008000||Viu
GETGRENT_R_HAS_FPTR|5.008000||Viu
GETGRENT_R_HAS_PTR|5.008000||Viu
GETGRENT_R_PROTO|5.008000|5.008000|Vn
getgrgid|5.009000||Viu
GETGRGID_R_HAS_BUFFER|5.008000||Viu
GETGRGID_R_HAS_PTR|5.008000||Viu
GETGRGID_R_PROTO|5.008000|5.008000|Vn
getgrnam|5.009000||Viu
GETGRNAM_R_HAS_BUFFER|5.008000||Viu

ppport.h  view on Meta::CPAN

KEY_format|5.003007||Viu
KEY_formline|5.003007||Viu
KEY_ge|5.003007||Viu
KEY_getc|5.003007||Viu
KEY_getgrent|5.003007||Viu
KEY_getgrgid|5.003007||Viu
KEY_getgrnam|5.003007||Viu
KEY_gethostbyaddr|5.003007||Viu
KEY_gethostbyname|5.003007||Viu
KEY_gethostent|5.003007||Viu
KEY_getlogin|5.003007||Viu

ppport.h  view on Meta::CPAN

Perl_pp_ftfile|5.013009||Viu
Perl_pp_ftmtime|5.013009||Viu
Perl_pp_ftpipe|5.013009||Viu
Perl_pp_ftrexec|5.013009||Viu
Perl_pp_ftrwrite|5.013009||Viu
Perl_pp_ftsgid|5.013009||Viu
Perl_pp_ftsize|5.013009||Viu
Perl_pp_ftsock|5.013009||Viu
Perl_pp_ftsuid|5.013009||Viu
Perl_pp_ftsvtx|5.013009||Viu
Perl_pp_ftzero|5.013009||Viu
Perl_pp_getpeername|5.013009||Viu
Perl_pp_getsockname|5.013009||Viu
Perl_pp_ggrgid|5.013009||Viu
Perl_pp_ggrnam|5.013009||Viu
Perl_pp_ghbyaddr|5.013009||Viu
Perl_pp_ghbyname|5.013009||Viu
Perl_pp_gnbyaddr|5.013009||Viu
Perl_pp_gnbyname|5.013009||Viu

ppport.h  view on Meta::CPAN

PerlProc_execv|5.005000||Viu
PerlProc_execvp|5.005000||Viu
PerlProc__exit|5.005000||Viu
PerlProc_exit|5.005000||Viu
PerlProc_fork|5.006000||Viu
PerlProc_getegid|5.005000||Viu
PerlProc_geteuid|5.005000||Viu
PerlProc_getgid|5.005000||Viu
PerlProc_getlogin|5.005000||Viu
PerlProc_GetOSError|5.006000||Viu
PerlProc_getpid|5.006000||Viu
PerlProc_gettimeofday|5.008000||Viu
PerlProc_getuid|5.005000||Viu

ppport.h  view on Meta::CPAN

PerlProc_pclose|5.005000||Viu
PerlProc_pipe|5.005000||Viu
PerlProc_pipe_cloexec|5.027008||Viu
PerlProc_popen|5.005000||Viu
PerlProc_popen_list|5.007001||Viu
PerlProc_setgid|5.005000||Viu
PerlProc_setjmp|5.005000||Viu
PerlProc_setuid|5.005000||Viu
PerlProc_signal|5.005000||Viu
PerlProc_sleep|5.005000||Viu
PerlProc_spawnvp|5.008000||Viu

ppport.h  view on Meta::CPAN

PL_defgv|5.004005|5.003007|p
PL_def_layerlist|5.007003||Viu
PL_defoutgv|5.005000||Viu
PL_defstash|5.005000||Viu
PL_delaymagic|5.005000||Viu
PL_delaymagic_egid|5.015008||Viu
PL_delaymagic_euid|5.015008||Viu
PL_delaymagic_gid|5.015008||Viu
PL_delaymagic_uid|5.015008||Viu
PL_destroyhook|5.010000||Viu
PL_diehook|5.005000|5.003007|poVnu
PL_Dir|5.006000||Viu
PL_dirty|5.005000|5.003007|poVnu

ppport.h  view on Meta::CPAN

setfd_cloexec|5.027008||Vniu
setfd_cloexec_for_nonsysfd|5.027008||Viu
setfd_cloexec_or_inhexec_by_sysfdness|5.027008||Viu
setfd_inhexec|5.027008||Vniu
setfd_inhexec_for_sysfd|5.027008||Viu
setgid|5.005000||Viu
setgrent|5.009000||Viu
SETGRENT_R_HAS_FPTR|5.008000||Viu
SETGRENT_R_PROTO|5.008000|5.008000|Vn
sethostent|5.005000||Viu
SETHOSTENT_R_PROTO|5.008000|5.008000|Vn

ppport.h  view on Meta::CPAN

SETPROTOENT_R_PROTO|5.008000|5.008000|Vn
setpwent|5.009000||Viu
SETPWENT_R_HAS_FPTR|5.008000||Viu
SETPWENT_R_PROTO|5.008000|5.008000|Vn
set_regex_pv|5.029004||Viu
setregid|5.003007||Viu
setreuid|5.003007||Viu
SETs|5.003007||Viu
setservent|5.005000||Viu
SETSERVENT_R_PROTO|5.008000|5.008000|Vn
setsockopt|5.005000||Viu

ppport.h  view on Meta::CPAN

SvRXOK|5.009005|5.003007|p
SV_SAVED_COPY|5.009005||Viu
SvSCREAM|5.003007||Viu
SvSCREAM_off|5.003007||Viu
SvSCREAM_on|5.003007||Viu
sv_setgid|5.019001||Viu
sv_sethek|5.015004||cViu
sv_setiv|5.003007|5.003007|
sv_setiv_mg|5.004005|5.003007|p
SvSETMAGIC|5.003007|5.003007|
SvSetMagicSV|5.004000|5.004000|

 view release on metacpan or  search on metacpan

lib/CDS.pm  view on Meta::CPAN

	}

	# mkdir (if it does not exist yet) and chmod (if it does exist already)
	mkdir $folder, $o->{permissions}->baseFolderMode;
	chmod $o->{permissions}->baseFolderMode, $folder;
	chown $o->{permissions}->uid // -1, $o->{permissions}->gid // -1, $folder;

	# Check if the result is correct
	my @s = stat $folder;
	return $o->{ui}->error('Unable to create ', $o->{foldername}, '.') if ! scalar @s;
	my $mode = $s[2];
	return $o->{ui}->error($folder, ' exists, but is not a folder') if ! Fcntl::S_ISDIR($mode);
	return $o->{ui}->error('Unable to set the owning user ', $o->{permissions}->user, ' for ', $folder, '.') if defined $o->{permissions}->uid && $s[4] != $o->{permissions}->uid;
	return $o->{ui}->error('Unable to set the owning group ', $o->{permissions}->group, ' for ', $folder, '.') if defined $o->{permissions}->gid && $s[5] != $o->{permissions}->gid;
	return $o->{ui}->error('Unable to set the mode on ', $folder, '.') if ($mode & 0777) != $o->{permissions}->baseFolderMode;
	return 1;
}

sub existingFolderStoreOrShowError {

lib/CDS.pm  view on Meta::CPAN

	$o->{ui}->space;
	$o->{ui}->p('Traversal failed because a file or folder could not be accessed. You may have to fix the permissions manually, or run this command with other privileges.');
	$o->{ui}->p('If you have root privileges, you can take over this store using:');
	my $userName = getpwuid($<);
	my $groupName = getgrgid($();
	$o->{ui}->line($o->{ui}->gold('  sudo chown -R ', $userName, ':', $groupName, ' ', $folderStore->folder));
	$o->{ui}->p('and then set the desired permission scheme:');
	$o->{ui}->line($o->{ui}->gold('  cds set permissions of ', $folderStore->folder, ' to …'));
	$o->{ui}->space;
	exit(1);

lib/CDS.pm  view on Meta::CPAN

sub wrong {
	my $o = shift;
	my $item = shift;
	my $uid = shift;
	my $gid = shift;
	my $mode = shift;
	my $expectedUid = shift;
	my $expectedGid = shift;
	my $expectedMode = shift;

	my $len = length $o->{baseFolder};
	$o->{wrong} += 1;
	$item = '…'.substr($item, $len) if length $item > $len && substr($item, 0, $len) eq $o->{baseFolder};
	my @changes;
	push @changes, 'user '.&username($uid).' -> '.&username($expectedUid) if defined $expectedUid && $uid != $expectedUid;
	push @changes, 'group '.&groupname($gid).' -> '.&groupname($expectedGid) if defined $expectedGid && $gid != $expectedGid;
	push @changes, 'mode '.sprintf('%04o -> %04o', $mode, $expectedMode) if $mode != $expectedMode;
	return $o->finalizeWrong(join(', ', @changes), "\t", $item);
}

sub username {

lib/CDS.pm  view on Meta::CPAN

	return getpwuid($uid) // $uid;
}

sub groupname {
	my $gid = shift;

	return getgrgid($gid) // $gid;
}

sub accessError {
	my $o = shift;
	my $item = shift;

lib/CDS.pm  view on Meta::CPAN

}

# Handles POSIX permissions (user, group, and mode).
package CDS::FolderStore::PosixPermissions;

# Returns the permissions set corresponding to the mode, uid, and gid of the base folder.
# If the permissions are ambiguous, the more restrictive set is chosen.
sub forFolder {
	my $class = shift;
	my $folder = shift;

lib/CDS.pm  view on Meta::CPAN

		($mode & 070) == 070 ? CDS::FolderStore::PosixPermissions::Group->new($s[5]) :
			CDS::FolderStore::PosixPermissions::User->new($s[4]);
}

sub uid { shift->{uid} }
sub gid { shift->{gid} }

sub user {
	my $o = shift;

	my $uid = $o->{uid} // return;

lib/CDS.pm  view on Meta::CPAN

}

sub group {
	my $o = shift;

	my $gid = $o->{gid} // return;
	return getgrgid($gid) // $gid;
}

sub writeTemporaryFile {
	my $o = shift;
	my $folder = shift;

lib/CDS.pm  view on Meta::CPAN

	close $fh;

	# Set the permissions
	chmod $mode, $temporaryFile;
	my $uid = $o->uid;
	my $gid = $o->gid;
	chown $uid // -1, $gid // -1, $temporaryFile if defined $uid && $uid != $< || defined $gid && $gid != $(;
	return $temporaryFile;
}

sub mkdir {
	my $o = shift;

lib/CDS.pm  view on Meta::CPAN

	my $success = mkdir $folder, $mode;

	# Set the permissions
	chmod $mode, $folder;
	my $uid = $o->uid;
	my $gid = $o->gid;
	chown $uid // -1, $gid // -1, $folder if defined $uid && $uid != $< || defined $gid && $gid != $(;
	return $success;
}

# Check the permissions of a file or folder, and fix them if desired.
# A logger object is called for the different cases (access error, correct permissions, wrong permissions, error fixing permissions).

lib/CDS.pm  view on Meta::CPAN

	my $item = shift;
	my $expectedMode = shift;
	my $logger = shift;

	my $expectedUid = $o->uid;
	my $expectedGid = $o->gid;

	# Stat the item
	my @s = stat $item;
	return $logger->accessError($item) if ! scalar @s;
	my $mode = $s[2] & 07777;
	my $uid = $s[4];
	my $gid = $s[5];

	# Check
	my $wrongUid = defined $expectedUid && $uid != $expectedUid;
	my $wrongGid = defined $expectedGid && $gid != $expectedGid;
	my $wrongMode = $mode != $expectedMode;
	if ($wrongUid || $wrongGid || $wrongMode) {
		# Something is wrong
		$logger->wrong($item, $uid, $gid, $mode, $expectedUid, $expectedGid, $expectedMode) || return 1;

		# Fix uid and gid
		if ($wrongUid || $wrongGid) {
			my $count = chown $expectedUid // -1, $expectedGid // -1, $item;
			return $logger->setError($item) if $count < 1;
		}

lib/CDS.pm  view on Meta::CPAN

			my $count = chmod $expectedMode, $item;
			return $logger->setError($item) if $count < 1;
		}
	} else {
		# Everything is OK
		$logger->correct($item, $mode, $uid, $gid);
	}

	return 1;
}

lib/CDS.pm  view on Meta::CPAN

use parent -norequire, 'CDS::FolderStore::PosixPermissions';

sub new {
	my $class = shift;
	my $gid = shift;

	return bless {gid => $gid // $(};
}

sub target {
	my $o = shift;
	 'members of the group '.$o->group }

 view release on metacpan or  search on metacpan

Common.pm  view on Meta::CPAN

  my ($pid,$sid,$t,$t1,$t2) = (); 
     $pid = $ar->{pid} if (exists $ar->{pid} && $ar->{pid}); 
     $sid = $ar->{sid} if (exists $ar->{sid} && $ar->{sid});
     $sid = $ar->{study_id} if (!$sid && exists $ar->{study_id});
     $sid = $ar->{sel_sn1} if (!$sid && exists $ar->{sel_sn1}); 
  my $usr_gid = (exists $ar->{guid}) ? $ar->{guid} : "";      
  my $ksb = eval $s->set_param('var2sub',$ar);     
  my $far = $amg->{$tsk}; 				# form message
  my $cls = eval $s->set_param('code_lists',$ar);	# code lists
 
  my $f_in  = "<input name=\"%s\" value=\"%s\" />"; 

Common.pm  view on Meta::CPAN

  my $tb  = sprintf $f_tb, $title, $t; 
     $t1  = sprintf $f_ih, "pid", $pid 		if $pid || $pid =~ /^0$/;
     $t1 .= sprintf $f_ih, "sel_sn1", $sid	if $sid || $sid =~ /^0$/;
     $t1 .= sprintf $f_ih, "task", $tsk;
     $t1 .= sprintf $f_ih, "no_dispform", 1;
     $t1 .= sprintf $f_ih, "guid", $usr_gid	if $usr_gid;     
  print $q->header("text/html");
  print $q->start_html(%{$ar->{html_header}});
  printf $f_fm, "R", "$t1$tb"; 
  $ar->{bottom_nav} = ''; 
}

 view release on metacpan or  search on metacpan

Define.pm  view on Meta::CPAN

    }
    $ds = $ar->{dir_sep} 			if exists $ar->{dir_sep}; 
    $ds = ($^O =~ /^MSWin/i) ? '\\' : '/' 	if ! $ds; 
    $ar->{ds} = $ds				if ! exists $ar->{ds}; 

    my $usr_gid = (exists $ar->{guid} && $ar->{guid}) ? $ar->{guid} : ""; 
    my ($usr_sid,$usr_uid,$usr_tmo) = split /:/, $usr_gid; 
    $r->{guid}  = $usr_gid 	if $usr_gid; 
    $r->{pid}	= $pid;	$ar->{pid} = $pid;     
    $r->{sid}   = $sn;	$ar->{sid} = $sn; 
    $r->{dtm}	= strftime "%Y%m%d_%H%M%S", localtime; 
    $r->{dt} 	= substr $r->{dtm}, 0, 8;
    $r->{tm} 	= substr $r->{dtm}, 9, 6;

 view release on metacpan or  search on metacpan

HTML.pm  view on Meta::CPAN

      $url .= "?pid=$pid&no_dispform=1&sel_sn1=$sn";
    my $f_a2 = "<a href=\"%s\" target=\"%s\" title=\"%s\">%s</a>\n";     
    my $u1b = "$url&task=disp_new&new_task=run_login"; 
    my $s1b = sprintf $f_a2, $u1b, "R", "Login User", "Login>>";    
       $vs  = 'guid,user_uid,user_pwd,user_sid,user_tmo';
    my ($usr_gid,$usr_uid,$usr_pwd,$usr_sid,$usr_tmo) = $s->get_params($vs,$ar);
    my @aa = ($usr_gid) ? (split /:/, $usr_gid) : (); 
       $usr_sid = $aa[0]	if !$usr_sid; 
       $usr_uid = $aa[1]	if !$usr_uid; 
       $usr_tmo = $aa[2]	if !$usr_tmo; 
    my $sid = (exists $ar->{logout} && $ar->{logout}) ? "" : "&guid=$usr_gid";    
    my $mpt = (exists $pv->{mpt} && $pv->{mpt}) ? $pv->{mpt} : "&task=disp_links";
    my $msg = "($prg) ";     
    
    # 2. get page definition
    my $pd = {}; 

HTML.pm  view on Meta::CPAN

      $url .= "?pid=$pid&no_dispform=1&sel_sn1=$sn";
    my $f_a2 = "<a href=\"%s\" target=\"%s\" title=\"%s\">%s</a>\n";     
    my $u1b = "$url&task=disp_new&new_task=run_login"; 
    my $s1b = sprintf $f_a2, $u1b, "R", "Login User", "Login>>";    
       $vs  = 'guid,user_uid,user_pwd,user_sid,user_tmo';
    my ($usr_gid,$usr_uid,$usr_pwd,$usr_sid,$usr_tmo) = $s->get_params($vs,$ar);

    # my $sid = "&user_uid=$usr_uid&user_sid=$usr_sid&user_tmo=$usr_tmo";    
    my $sid = "&guid=$usr_gid";    
    my $mpt = (exists $pv->{mpt} && $pv->{mpt}) ? $pv->{mpt} : "&task=disp_links";
    my $msg = "($prg) ";     
        
    # 2. get page definition
    my $pd = {}; 

HTML.pm  view on Meta::CPAN

      $url .= "?pid=$pid&no_dispform=1&sel_sn1=$sn";
    my $f_a2 = "<a href=\"%s\" target=\"%s\" title=\"%s\">%s</a>\n";     
    my $u1b = "$url&task=disp_new&new_task=run_login"; 
    my $s1b = sprintf $f_a2, $u1b, "R", "Login User", "Login>>";    
       $vs  = 'guid,user_uid,user_pwd,user_sid,user_tmo';
    my ($usr_gid,$usr_uid,$usr_pwd,$usr_sid,$usr_tmo) = $s->get_params($vs,$ar);

    # my $sid = "&user_uid=$usr_uid&user_sid=$usr_sid&user_tmo=$usr_tmo";    
    my $sid = ($tsk =~ /logout$/i) ? "&guid=$usr_gid&logout=1" : "&guid=$usr_gid";    
    my $mpt = (exists $pv->{mpt} && $pv->{mpt}) ? $pv->{mpt} : "&task=disp_links";
    my $msg = "($prg) "; 
    if (!$usr_gid) {
      $msg = "No user credential ($usr_gid)."; 
      print $q->header("text/html");
      print $q->start_html(%{$ar->{html_header}});
      $s->disp_param($ar->{_sql_output}) if exists $ar->{_sql_output}; 
      print "$msg<br> Please $s1b<br>\n";
      print $q->end_html; 
      exit;
    } else { 
      my @ss = split /:/, $usr_gid;
      $usr_sid = $ss[0] if !$usr_sid;
      $usr_uid = $ss[1] if !$usr_uid;
      $usr_tmo = $ss[2] if !$usr_tmo;
    }    
    my $op = (exists $ar->{_sql_output}) ? $ar->{_sql_output} : [];

HTML.pm  view on Meta::CPAN

    $s->echo_msg("ERR: ($prg) no files to be linked.", 0);
    return; 
  }

  my $vs = 'pid,sid,guid,script_url';
  my ($pid,$sid,$usr_gid,$url) = $s->get_params($vs,$ar); 
  my $ug = ($usr_gid) ? "&guid=$usr_gid" : ""; 
  
  my $u1  = "$url?pid=$pid&sel_sn1=$sid$ug&task=disp_file&f=";
  my $f_aa = "<a href=\"%s\" target=R>%s</a>\n"; 
  my $f_a2 = "<a href=\"%s\" target=\"%s\" title=\"%s\">%s</a>\n"; 
  my $f_li = "  <li><a href=\"%s\">%s</a></li>\n";  

 view release on metacpan or  search on metacpan

Login.pm  view on Meta::CPAN

  my %cfg = (usr=>'jsmith', pwd=>'jojo');
  my @names = $q->param;
  foreach my $k (@names) { $cfg{$k} = $q->param($k) if ! exists $cfg{$k}; }
  $self->get_access($q, \%cfg);

Return: $hr - access hash array ref: ${$hr}{uid|gid}{$name} = $uid|$giu

This method retrieves portal access user and group files and access_users and
access_groups in the configuration file to build an access list.

=cut

Login.pm  view on Meta::CPAN

    my $xs = new XML::Simple;
    my $grf = $xs->XMLin($xml_grp);
    my $urf = $xs->XMLin($xml_usr);
    
    my %uid = ();  # User ID   hash array 
    my %gid = ();  # Group ID  hash array
    my %lku = ();  # User and group ID lookup 
    foreach my $hr (@{${$urf}{user}}) {
        my $i = ${$hr}{uid};
        my $e = lc ${$hr}{email};
        next if $e !~ /^($ua_list)/i;

Login.pm  view on Meta::CPAN

    }

    ${$ar}{_uid} = \%uid;
    $s->disp_param(${$ar}{_uid}) if ${$ar}{v};
    foreach my $hr (@{${$grf}{group}}) {
        my $i = ${$hr}{gid};
        my $e = lc ${$hr}{groupname};
        next if $e !~ /^($ga_list)/i;
        foreach my $k (keys %{$hr}) {
            next if $k =~ /^gid/i;
            $gid{$i}{$k} = ${$hr}{$k};
            $lku{gid}{$e} = $i;
        }
    }
    ${$ar}{_gid} = \%gid;
    $s->disp_param(${$ar}{_gid}) if ${$ar}{v};
    # build a access list
    my %ac = ();
    
    foreach my $k (split /\|/, $ua_list) { 
        $ac{uid}{$k} = (exists $lku{uid}{$k})?$lku{uid}{$k}:"";
        print "WARN: User $k does not exist.\n" if !$ac{uid}{$k} && ${$ar}{v};
    }
    foreach my $k (split /\|/, $ga_list) { 
        $ac{gid}{$k} = (exists $lku{gid}{$k})?$lku{gid}{$k}:""; 
        print "WARN: Group $k does not exist.\n" if !$ac{gid}{$k} && ${$ar}{v};
    }
    $s->disp_param(\%ac) if ${$ar}{v};
    return \%ac;
}

Login.pm  view on Meta::CPAN

    }
    foreach my $k (split /\|/, $ga_list) { 
        my $g1 = $obj->GetGroupID($k);    # get group id
        next if ! $g1;                    # did not find the group        
        my $o1 = $obj->GetGroupObj($g1);  # get group object
        $ac{gid}{"$g1"} = $k;             # group id and name
    }
    return 1000 if exists $ac{uid}{"$uid"}; 

    foreach my $g (split /,/, ${$obj_u}{GroupsList}) {
        my $go = $obj->GetGroupObj($g);
        my $gi = ${$go}{GroupID};
        return 1001 if exists $ac{gid}{"$gi"};
    }
    return 154;   # did not find in the group access
}

1;

 view release on metacpan or  search on metacpan

MapDisps.pm  view on Meta::CPAN

  my $pr  = $s->def_inputvars($ar);
  my $pid = (exists $pr->{pid} && $pr->{pid}) ? $pr->{pid} : '';      
  if (!$pid) {
    $s->echo_msg("ERR: ($prg) pid is not defined.", 0); return; 
  }
  my $usr_gid = (exists $ar->{guid}) ? $ar->{guid} : ""; 
  my $ug      = ($usr_gid) ? "&guid=$usr_gid" : ""; 

  foreach my $k (split /,/, $ids) {
    $p->{$k} = $pr->{$k} if exists $pr->{$k}; 
  }

MapDisps.pm  view on Meta::CPAN

  my $pid = $pr->{pid}; 			# project id: ckpt, dba, owb			
  my $sn  = $pr->{sid}; 			# server id

  $s->set_ids($ar); 
  my $vs = 'user_sid,user_uid,user_tmo,guid';
  my ($usr_sid,$usr_uid,$usr_tmo,$usr_gid) = $s->get_params($vs, $ar);
  
  my $url = $pr->{web_url};			# web URL
    $url .= "?pid=$pid&no_dispform=1&sel_sn1=$sn";
    $url .= (exists $ar->{logout} && $ar->{logout}) ? "" : "&guid=$usr_gid";
    
  if (!$pid) {
    $s->echo_msg("ERR: ($prg) PID has not been defined.",0); return; 
  }
  if (!$sn) {

MapDisps.pm  view on Meta::CPAN

    $s->echo_msg("WARN: No records.",0); return; 
  }

  # 1. define variables
  my $vs = 'pid,sid,guid,web_url,task';
  my ($pid,$sid,$usr_gid,$url,$tsk) = $s->get_params($vs,$ar); 
     $sid = $ar->{sel_sn1}		if !$sid && exists $ar->{sel_sn1}; 
  my $tgt = (exists $ar->{fr_tgt}) ? $ar->{fr_tgt} : "R";	# frame target

  my $tk = $tsk; $tk =~ s/(disp_)//;  
  my $tr = {'client'=>'project','project'=>'study','study'=>'list','list'=>'job' };

MapDisps.pm  view on Meta::CPAN

           ,'list'=>'list_id','spec'=>'spec_id', 'job'=>'job_id' };
  my $nm = {'client'=>'cln_name','project'=>'prj_name','study'=>'study_name'
           ,'list'=>'sponsor','spec'=>'source_dataset', 'job'=>'job_name' };

  $url =~ s/(\?.*)//    	if $url;	# remove parameters
  $url .= "?pid=$pid&sel_sn1=$sid&guid=$usr_gid"; 
    
  # 2. check required variables 
  if (!$pid) {
    $s->echo_msg("ERR: could not find pid in build_links.",0); return;
  }

 view release on metacpan or  search on metacpan

MapSecus.pm  view on Meta::CPAN

  # we return OK if the tmo has more than 10 minutes remaining
  return (1, 'OK') if ($usr_tmo && ($usr_tmo>$ctm) 
    && (($usr_tmo-$ctm) > 0.0010));

  # 1. check session id
  my ($id_OK, $usr_gid) = $s->set_guid($ar); 
  $usr_gid = ($usr_gid) ? $usr_gid : '' ;
  if (! $id_OK) {
    print $q->header("text/html");
    print $q->start_html(%{$ar->{html_header}});
    print "$usr_gid<br>\n"; 
    print "Please $s1b<br>\n";
    print $q->end_html; 
    exit;
  }
  if (!$usr_gid) {
    # $msg = "No user credential.<br>"; 
    print $q->header("text/html");
    print $q->start_html(%{$ar->{html_header}});
    print "Please $s1b<br>\n";
    print $q->end_html; 
    exit;
  } else { 
    my @ss = split /:/, $usr_gid;
    $usr_sid = $ss[0] if !$usr_sid;
    $usr_uid = $ss[1] if !$usr_uid;
    $usr_tmo = $ss[2] if !$usr_tmo;
  }
  $ar->{app_user} = $usr_uid if !$usr_app && $usr_uid; 
  $ar->{guid}     = $usr_gid if !$guid    && $usr_gid; 

  # 2. check timeout

  $msg = "OK: "; 
  $msg .= "got user $usr_uid " 	if $usr_uid;
  $msg .= "and its password " 	if $usr_pwd;
  $msg .= "and GID = $usr_gid " if $usr_gid;
  $msg .= "for task $tsk";
  $msg .= ($ntsk) ? "->$ntsk.<br>\n" : ".<br>\n"; 
  if ($usr_tmo && $usr_tmo > $ctm) { 
    $msg .= "This session will be expired at $usr_tmo.<br>"; 
  } else {

MapSecus.pm  view on Meta::CPAN

  }
  return (1,$msg) if ( ($tsk =~ /(login)$/i && $usr_uid && $usr_pwd) 
    || ($usr_tmo && $usr_tmo > $ctm) || $tsk =~ /(setanypwd)$/i); 

  # 3. check if we need to start the login page
  $u1b .= "&guid=$usr_gid"; 
  
  if (!$usr_gid || $usr_tmo && $usr_tmo < $ctm ) {
    print $q->header("text/html");
    print $q->start_html(%{$ar->{html_header}});
    print "$msg\nPlease $s1b<br>\n";
    print $q->end_html; 
    exit; 

MapSecus.pm  view on Meta::CPAN

  my $r = {}; 
  foreach my $k (split /,/, $vs) {
    $r->{$k}  = $rr->[0]{$k}; 
    $ar->{$k} = $rr->[0]{$k} if !exists $ar->{$k} || $ar->{$k} !~ /^\d+$/; 
  }
  my $usr_gid = (exists $ar->{guid}) ? $ar->{guid} : "";
  my $aa = ($usr_gid) ? [split /:/, $usr_gid] : []; 
  $ar->{user_sid} = $aa->[0] 	if !exists $ar->{user_sid} && exists $aa->[0]; 
  $ar->{user_uid} = $aa->[1] 	if !exists $ar->{user_uid} && exists $aa->[1]; 
  $ar->{user_tmo} = $aa->[2] 	if !exists $ar->{user_tmo} && exists $aa->[2]; 
  
  wantarray ? %$r : $r; 

 view release on metacpan or  search on metacpan

Security.pm  view on Meta::CPAN

First define the parameters in the initial file or define all the parameters
in a hash array reference as $ar->{$p} where $p are

  task     = task_name
  sel_sn1  = a_db_name_or_server_name
  app_user = logname_or_logid
  usr_role = {
    usr1 = [qw(dba owb)],
    usr2 = [qw(r1 r2)],
   }
  usr_task = {

 view release on metacpan or  search on metacpan

lib/CGI/Application/Bouquet/Rose.pm  view on Meta::CPAN

	Step 9: Install the FastCGId script:
	shell> sudo cp -r htdocs/search /var/www
	shell> sudo chmod a+x /var/www/search/wine.fcgi

	Step 10: Patch httpd.conf (see httpd/httpd.conf.patch):
	LoadModule fcgid_module modules/mod_fcgid.so
	<Location /search>
	    SetHandler fcgid-script
	    Options ExecCGI
		Order deny,allow
	    Deny from all
	    Allow from 127.0.0.1
	</Location>

 view release on metacpan or  search on metacpan

lib/CGI/Application/Demo/Ajax.pm  view on Meta::CPAN

=head2 Configure C<Apache> to use local/ajax

If in fancy mode, add these to httpd.conf:

	LoadModule fcgid_module modules/mod_fcgid.so

and:

	<Location /local>
		SetHandler fcgid-script
		Options ExecCGI
		Order deny,allow
		Deny from all
		Allow from 127.0.0.1
	</Location>

 view release on metacpan or  search on metacpan

lib/CGI/Application/Demo/Dispatch.pm  view on Meta::CPAN

=head2 Configure C<Apache> to use /local/dispatch

If in fancy mode, add these to C<Apache>'s httpd.conf:

	LoadModule fcgid_module modules/mod_fcgid.so

and:

	<Location /local>
		SetHandler fcgid-script
		Options ExecCGI
		Order deny,allow
		Deny from all
		Allow from 127.0.0.1
	</Location>

 view release on metacpan or  search on metacpan

CAF_MB_Installer.pm  view on Meta::CPAN

    my @server_files = (
        $self->notes('file_sqlite_db'),
    );

    my $uid = $self->notes('web_server_user_num');
    my $gid = $self->notes('web_server_group_num');

    my $destdir = $self->{properties}{destdir} || '';

    foreach my $server_path (@server_paths) {

CAF_MB_Installer.pm  view on Meta::CPAN

            print "Make sure this path is writeable by your webserver:\n\t$server_path\n";
            next;
        }

        print "making path writeable by webserver: $server_path\n" if $verbose;
        chown $uid, $gid, $server_path
            or warn "Could not make the following path writeable by the webserver - you'll have to do it manually:\n\t$server_path\n";

        # Make writeable
        my $current_mode = (stat $server_path)[2];
        chmod $current_mode | 0600, $server_path;

 view release on metacpan or  search on metacpan

t/lib/Test/CAPRESTResource.pm  view on Meta::CPAN

    if (defined $self->query->param('noargs')) {
        $self->rest_resource();
    }

    if (defined $self->query->param('bogusargs')) {
        $self->rest_resource('midget', 'gidget', 'apt-get');
    }

    if (defined $self->query->param('bogusresource')) {
        my $resource = {
            prefix     => 'foo',

 view release on metacpan or  search on metacpan

templates/prototype_javascript.tmpl  view on Meta::CPAN

  show: function() {
    if(this.update.style.display=='none') this.options.onShow(this.element, this.update);
    if(!this.iefix && (navigator.appVersion.indexOf('MSIE')>0) && this.update.style.position=='absolute') {
      new Insertion.After(this.update, 
       '<iframe id="' + this.update.id + '_iefix" '+
       'style="display:none;filter:progid:DXImageTransform.Microsoft.Alpha(opacity=0);" ' +
       'src="javascript:false;" frameborder="0" scrolling="no"></iframe>');
      this.iefix = $(this.update.id+'_iefix');
    }
    if(this.iefix) {
      Position.clone(this.update, this.iefix);

 view release on metacpan or  search on metacpan

lib/CGI/Application/Util/Diff.pm  view on Meta::CPAN

=head2 Configure C<Apache> to use /local/util.diff

If in fancy mode, add these to C<Apache>'s httpd.conf:

	LoadModule fcgid_module modules/mod_fcgid.so

and:

	<Location /local>
		SetHandler fcgid-script
		Options ExecCGI
		Order deny,allow
		Deny from all
		Allow from 127.0.0.1
	</Location>

 view release on metacpan or  search on metacpan

lib/CGI/Builder/CgiAppAPI.pm  view on Meta::CPAN

The CBF implements a different metaphor based on 'processing pages' instead of 'running applications'. This should be simpler to understand (specially for beginners) because it is more consistent with the specific task that a CGI::Builder application...

Even if the internal implementation of similar methods is greatly improved and has a completely different internal code, from the user point of view most changes here don't require more than a simple translation of identifier from one concept to the ...

The CGI::Application philosophy is very simple: the application defines several run methods, and each run method is organized to produce and return its own output page. You have to set a map in the application to define what run method has to be call...

The CBF let you organize your application in a far more flexible way, it just need to find some C<page_content> to send to the client: it does not matter what method or handler has set it during the process, (and the C<page_content> itself might even...

This flexible structure open several handy and powerful possibilities to your application and to the extension system. If you want to know some more details about that, you could read L<CGI::Application::Plus/"Exclusive Features and Improvements"> wh...

 view release on metacpan or  search on metacpan

lib/CGI/ContactForm/MHonArc.pm  view on Meta::CPAN

The converted messages are supposed to include an HTML form for the purpose, so
you need to set one of the MHonArc page layout resources. This is an example:

    <form action="/cgi-bin/mhacontact.pl" method="get">
    <input type="hidden" name="msgid" value="$MSGID$">
    <input type="hidden" name="outdir" value="$OUTDIR$">
    <input type="submit" value="Contact Author">
    </form>

The form controls shall be named C<msgid> and C<outdir> (case matters), and their
values are set dynamically via the MHonArc C<$MSGID$> respective C<$OUTDIR$>
resource variables when the messages are converted.

Note that it is a C<GET> request that shall be submitted.

lib/CGI/ContactForm/MHonArc.pm  view on Meta::CPAN

    local $^W = 1;
    my %msg;

    if ($ENV{REQUEST_METHOD} eq 'GET') {
        my $q = new CGI;
        my $id = $q->param('msgid') or CFdie("Message ID is missing.\n");
        my %nodot;
        @nodot{ qw/MSWin32 dos os2 VMS/ } = ();
        my $defaultdb = exists $nodot{$^O} ? 'mhonarc.db' : '.mhonarc.db';
        my $dbfile = (shift or $defaultdb);
        unless ( File::Spec->file_name_is_absolute($dbfile) ) {

 view release on metacpan or  search on metacpan

bin/cfm-passwd.pl  view on Meta::CPAN

	chomp(my $newpw = <STDIN>);
	print "Home: ";
	chomp(my $home = <STDIN>);
	my $uid = $pw->maxuid || 0;
	$uid++;
	my $gid = 10;
	my $shell = "none";
	my $geco = $username;
	$pw->user($username, $pw->encpass($newpw), $uid, $gid, $geco, $home, $shell);
	$pw->commit();
	exit;
}
	

 view release on metacpan or  search on metacpan

lib/CGI/Kwiki/I18N.pm  view on Meta::CPAN

    my $UseFuzzy = CGI::Kwiki::I18N::Lexicon::option('use_fuzzy');

    # Parse PO files
    foreach (@_) {
	/^(msgid|msgstr) +"(.*)" *$/	? do {	# leading strings
	    $var{$1} = $2;
	    $key = $1;
	} :

	/^"(.*)" *$/			? do {	# continued strings

lib/CGI/Kwiki/I18N.pm  view on Meta::CPAN

	/^#, +(.*) *$/			? do {	# control variables
	    $var{$_} = 1 for split(/,\s+/, $1);
	} :

	/^ *$/ && %var			? do {	# interpolate string escapes
	    push @ret, (map transform($_), @var{'msgid', 'msgstr'})
		if length $var{msgstr} and !$var{fuzzy} or $UseFuzzy;
	    push @metadata, parse_metadata($var{msgstr})
		if $var{msgid} eq '';
	    %var = ();
	} : ();
    }

    push @ret, map { transform($_) } @var{'msgid', 'msgstr'}
	if length $var{msgstr};
    push @metadata, parse_metadata($var{msgstr})
	if $var{msgid} eq '';

    return {@metadata, @ret};
}

sub parse_metadata {

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

 - Update Module::Install to 1.16 version.
 - Update copyright years.

0.05 2014-11-02T12:31:33+01:00
 - Add EXAMPLE section to doc.
 - Fix functionality with Apache2 mod_fcgid.
 - Remove 'init' parameter check.
 - Rewrite B<> to C<> in doc.
 - Simplify code.
 - Update Module::Install to 1.14 version.

 view release on metacpan or  search on metacpan

src/speedy_main.c  view on Meta::CPAN

	if (speedy_util_geteuid() == 0) {
	    int new_uid;

	    /* Set group-id */
	    if (speedy_script_getstat()->st_mode & S_ISGID) {
		if (setegid(speedy_script_getstat()->st_gid) == -1)
		    speedy_util_die("setegid");
	    }

	    /* Must set euid to something - either the script owner
	     * or the real-uid
	     */

 view release on metacpan or  search on metacpan

bin/cipp-l10n  view on Meta::CPAN

    my $msg_id_bug_email = $domain_conf->{msg_id_bug_email}
                           || "BUGS <EMAIL\@ADDRESS>";

    print $fh <<__EOH;
#. Generated with cipp-l10n - Copyright (C) dimedis GmbH
msgid ""
msgstr ""
"Project-Id-Version: $domain\\n"
"POT-Creation-Date: (null)\\n"
"PO-Revision-Date: (null)\\n"
"Last-Translator: TRANSLATOR NAME <EMAIL\@ADDRESS>\\n"
"Language-Team: $lang_team_email\\n"
"Report-Msgid-Bugs-To: $msg_id_bug_email\\n"
"MIME-Version: 1.0\\n"
"Content-Type: text/plain; charset=UTF-8\\n"
"Content-Transfer-Encoding: 8bit\\n"

__EOH

bin/cipp-l10n  view on Meta::CPAN

        if (  $message =~ m!\{.*\}! ) {
            print $fh qq[#, perl-brace-format\n];
        }

        if ( $message =~ /\n/ ) {
            print $fh qq[msgid ""\n];
            $message =~ s/^/"/gm;
            $message =~ s/\n/"\n/gm;
            $message .= qq["\n] if $message !~ /\n$/;
            print $fh $message;
        }
        else {
            print $fh qq[msgid "$message"\n];
        }
        print $fh qq[msgstr ""\n\n];
    }

    if ( $filename ) {

 view release on metacpan or  search on metacpan

lib/CLI/Framework/Application.pm  view on Meta::CPAN

    sub handle_exception {
        my ($app, $e) = @_;

        # Handle the exception represented by object $e...
        $app->my_error_logger( error => $e->error, pid => $e->pid, gid => $e->gid, ... );

        warn "caught error ", $e->error, ", continuing...";
        return;
    }

 view release on metacpan or  search on metacpan

bin/gwrap_ls.pl  view on Meta::CPAN

              when  showing  file  information  for a symbolic link, show information for the file the link
              references rather than for the link itself

       -m     fill width with a comma separated list of entries

       -n, --numeric-uid-gid
              like -l, but list numeric user and group IDs

       -N, --literal
              print raw entry names (don't treat e.g. control characters specially)

 view release on metacpan or  search on metacpan

easyxs/ppport.h  view on Meta::CPAN

get_cvs|5.011000|5.003007|p
getcwd_sv|5.007002|5.007002|
get_db_sub|||iu
get_debug_opts|5.008001||Viu
get_deprecated_property_msg|5.031011||cVniu
getegid|5.005000||Viu
getenv|5.005000||Viu
getenv_len|5.006000||Viu
GETENV_LOCK|5.033005||Viu
GETENV_PRESERVES_OTHER_THREAD|5.033005|5.033005|Vn
GETENV_UNLOCK|5.033005||Viu
geteuid|5.005000||Viu
getgid|5.005000||Viu
getgrent|5.009000||Viu
GETGRENT_R_HAS_BUFFER|5.008000||Viu
GETGRENT_R_HAS_FPTR|5.008000||Viu
GETGRENT_R_HAS_PTR|5.008000||Viu
GETGRENT_R_PROTO|5.008000|5.008000|Vn
getgrgid|5.009000||Viu
GETGRGID_R_HAS_BUFFER|5.008000||Viu
GETGRGID_R_HAS_PTR|5.008000||Viu
GETGRGID_R_PROTO|5.008000|5.008000|Vn
getgrnam|5.009000||Viu
GETGRNAM_R_HAS_BUFFER|5.008000||Viu

easyxs/ppport.h  view on Meta::CPAN

KEY_format|5.003007||Viu
KEY_formline|5.003007||Viu
KEY_ge|5.003007||Viu
KEY_getc|5.003007||Viu
KEY_getgrent|5.003007||Viu
KEY_getgrgid|5.003007||Viu
KEY_getgrnam|5.003007||Viu
KEY_gethostbyaddr|5.003007||Viu
KEY_gethostbyname|5.003007||Viu
KEY_gethostent|5.003007||Viu
KEY_getlogin|5.003007||Viu

easyxs/ppport.h  view on Meta::CPAN

Perl_pp_ftfile|5.013009||Viu
Perl_pp_ftmtime|5.013009||Viu
Perl_pp_ftpipe|5.013009||Viu
Perl_pp_ftrexec|5.013009||Viu
Perl_pp_ftrwrite|5.013009||Viu
Perl_pp_ftsgid|5.013009||Viu
Perl_pp_ftsize|5.013009||Viu
Perl_pp_ftsock|5.013009||Viu
Perl_pp_ftsuid|5.013009||Viu
Perl_pp_ftsvtx|5.013009||Viu
Perl_pp_ftzero|5.013009||Viu
Perl_pp_getpeername|5.013009||Viu
Perl_pp_getsockname|5.013009||Viu
Perl_pp_ggrgid|5.013009||Viu
Perl_pp_ggrnam|5.013009||Viu
Perl_pp_ghbyaddr|5.013009||Viu
Perl_pp_ghbyname|5.013009||Viu
Perl_pp_gnbyaddr|5.013009||Viu
Perl_pp_gnbyname|5.013009||Viu

easyxs/ppport.h  view on Meta::CPAN

PerlProc_execv|5.005000||Viu
PerlProc_execvp|5.005000||Viu
PerlProc__exit|5.005000||Viu
PerlProc_exit|5.005000||Viu
PerlProc_fork|5.006000||Viu
PerlProc_getegid|5.005000||Viu
PerlProc_geteuid|5.005000||Viu
PerlProc_getgid|5.005000||Viu
PerlProc_getlogin|5.005000||Viu
PerlProc_GetOSError|5.006000||Viu
PerlProc_getpid|5.006000||Viu
PerlProc_gettimeofday|5.008000||Viu
PerlProc_getuid|5.005000||Viu

easyxs/ppport.h  view on Meta::CPAN

PerlProc_pclose|5.005000||Viu
PerlProc_pipe|5.005000||Viu
PerlProc_pipe_cloexec|5.027008||Viu
PerlProc_popen|5.005000||Viu
PerlProc_popen_list|5.007001||Viu
PerlProc_setgid|5.005000||Viu
PerlProc_setjmp|5.005000||Viu
PerlProc_setuid|5.005000||Viu
PerlProc_signal|5.005000||Viu
PerlProc_sleep|5.005000||Viu
PerlProc_spawnvp|5.008000||Viu

easyxs/ppport.h  view on Meta::CPAN

PL_defgv|5.004005|5.003007|p
PL_def_layerlist|5.007003||Viu
PL_defoutgv|5.005000||Viu
PL_defstash|5.005000||Viu
PL_delaymagic|5.005000||Viu
PL_delaymagic_egid|5.015008||Viu
PL_delaymagic_euid|5.015008||Viu
PL_delaymagic_gid|5.015008||Viu
PL_delaymagic_uid|5.015008||Viu
PL_destroyhook|5.010000||Viu
PL_diehook|5.005000|5.003007|poVnu
PL_Dir|5.006000||Viu
PL_dirty|5.005000|5.003007|poVnu

easyxs/ppport.h  view on Meta::CPAN

setfd_cloexec|5.027008||Vniu
setfd_cloexec_for_nonsysfd|5.027008||Viu
setfd_cloexec_or_inhexec_by_sysfdness|5.027008||Viu
setfd_inhexec|5.027008||Vniu
setfd_inhexec_for_sysfd|5.027008||Viu
setgid|5.005000||Viu
setgrent|5.009000||Viu
SETGRENT_R_HAS_FPTR|5.008000||Viu
SETGRENT_R_PROTO|5.008000|5.008000|Vn
sethostent|5.005000||Viu
SETHOSTENT_R_PROTO|5.008000|5.008000|Vn

easyxs/ppport.h  view on Meta::CPAN

SETPROTOENT_R_PROTO|5.008000|5.008000|Vn
setpwent|5.009000||Viu
SETPWENT_R_HAS_FPTR|5.008000||Viu
SETPWENT_R_PROTO|5.008000|5.008000|Vn
set_regex_pv|5.029004||Viu
setregid|5.003007||Viu
setreuid|5.003007||Viu
SETs|5.003007||Viu
setservent|5.005000||Viu
SETSERVENT_R_PROTO|5.008000|5.008000|Vn
setsockopt|5.005000||Viu

easyxs/ppport.h  view on Meta::CPAN

SvSCREAM|5.003007||Viu
SvSCREAM_off|5.003007||Viu
SvSCREAM_on|5.003007||Viu
sv_setbool|5.035004|5.035004|
sv_setbool_mg|5.035004|5.035004|
sv_setgid|5.019001||Viu
sv_sethek|5.015004||cViu
sv_setiv|5.003007|5.003007|
sv_setiv_mg|5.004005|5.003007|p
SvSETMAGIC|5.003007|5.003007|
SvSetMagicSV|5.004000|5.004000|

 view release on metacpan or  search on metacpan

t/rcfile.t  view on Meta::CPAN

sub file_info
{
    my ($filename) = @_;

    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
        $atime,$mtime,$ctime,$blksize,$blocks)
    = stat($filename);

     return qq{
        Inode\t$ino
        Mode\t$mode
        UID\t$uid
        GID\t$gid
        Size\t$size
        Ctime\t$ctime
        Mtime\t$mtime
        Atime\t$atime
     };

 view release on metacpan or  search on metacpan

omnithreads/shared/t/hv_simple.t  view on Meta::CPAN

ok(10, $seen{1} == 1, "Keys..");
ok(11, $seen{2} == 1, "Keys..");
ok(12, $seen{3} == 1, "Keys..");
ok(13, $seen{"foo"} == 1, "Keys..");

# bugid #24407: the stringification of the numeric 1 got allocated to the
# wrong thread memory pool, which crashes on Windows.
ok(14, exists $hash{1}, "Check numeric key");

omnithreads->create(sub { %hash = () })->join();
ok(15, keys %hash == 0, "Check clear");