view release on metacpan or search on metacpan
Version 1.11 (released 6 December 2001, revision 80)
User-visible changes:
* major rewrite of the Make.PL script
* patched functions lsmount, rmmount (the values of an input argument
got corrupted)
* improved test driver for module AFS.pm
* updated README
Developer-visible changes:
* ACL->length, ACL->nlength, ACL->keys, ACL->nkeys:
keyword "keys" changed to CORE::keys
Version 1.10 (released 24 July 2001, revision 71)
User-visible changes:
* updated and corrected README
Developer-visible changes:
examples/v2/acl/retrieve view on Meta::CPAN
use AFS::ACL;
die "Usage: $0 path\n" if ($#ARGV!=0);
my $path = shift;
my $acl = AFS::ACL->retrieve($path);
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n";
if ($AFS::CODE) { print "AFS::CODE = $AFS::CODE\n"; }
else {
print "Normal rights: \n" if ($acl->length);
foreach my $user ($acl->get_users) {
print " $user ",$acl->get_rights($user),"\n";
}
print "Negative rights: \n" if ($acl->nlength);
foreach my $user ($acl->nget_users) {
print " $user ",$acl->nget_rights($user),"\n";
}
}
pod/v2/afsperlacl.pod view on Meta::CPAN
Removes all users and their access rights from the positive(-E<gt>clear) or
negative(-E<gt>nclear) ACL list.
=item B<@users = $acl-E<gt>get_users;>
=item B<@nusers = $acl-E<gt>nget_users;>
Returns users from the positive(-E<gt>get_users) or negative(-E<gt>nget_users)
ACL list.
=item B<$pos = $acl-E<gt>length;>
=item B<$npos = $acl-E<gt>nlength;>
Returns the number of users in the positive(-E<gt>length)
or negative(-E<gt>nlength) ACL list.
=item B<$acl-E<gt>exists(USER);>
=item B<$acl-E<gt>nexists(USER);>
Returns 1 if the given USER exists in the positive(-E<gt>exists)
or negative(-E<gt>nexists) ACL list.
=item B<$acl-E<gt>is_clean>
pod/v2/afsperlktct.pod view on Meta::CPAN
=item B<sessionKey>
Session encryption key of the token.
=item B<kvno>
Key version number associated with the Session encryption key.
=item B<ticketLen>
The length in bytes of the data stored in the attribute 'ticket'.
=item B<ticket>
The server ticket to use for the principal.
=back
=head1 METHODS
=over 4
src/ACL/ACL.pm view on Meta::CPAN
sub is_clean {
my $self = shift;
foreach ($self->get_users, $self->nget_users) { return 0 if (m/^-?\d+$/); }
return 1;
}
# comment Roland Schemers: I hope I don't have to debug these :-)
sub empty { $_[0] = bless [ {},{} ]; }
sub get_users { CORE::keys %{$_[0]->[0]}; }
sub length { int(CORE::keys %{$_[0]->[0]}); }
sub get_rights { ${$_[0]->[0]}{$_[1]}; }
sub exists { CORE::exists ${$_[0]->[0]}{$_[1]}; }
sub set { ${$_[0]->[0]}{$_[1]} = $_[2]; }
sub remove { delete ${$_[0]->[0]}{$_[1]}; }
sub clear { $_[0]->[0] = {}; }
sub keys { CORE::keys %{$_[0]->[0]}; } # old form: DEPRECATED !!!!
sub get { ${$_[0]->[0]}{$_[1]}; } # old form: DEPRECATED !!!!
sub del { delete ${$_[0]->[0]}{$_[1]}; } # old form: DEPRECATED !!!!
# comment Roland Schemers: same for negative entries
sub nget_users { CORE::keys %{$_[0]->[1]}; }
sub nlength { int(CORE::keys %{$_[0]->[1]}); }
sub nget_rights { ${$_[0]->[1]}{$_[1]}; }
sub nexists { CORE::exists ${$_[0]->[1]}{$_[1]}; }
sub nset { ${$_[0]->[1]}{$_[1]} = $_[2]; }
sub nremove { delete ${$_[0]->[1]}{$_[1]}; }
sub nclear { $_[0]->[1] = {}; }
sub nkeys { CORE::keys %{$_[0]->[1]}; } # old form: DEPRECATED !!!!
sub nget { ${$_[0]->[1]}{$_[1]}; } # old form: DEPRECATED !!!!
sub ndel { delete ${$_[0]->[1]}{$_[1]}; } # old form: DEPRECATED !!!!
src/ACL/t/ACL.t view on Meta::CPAN
can_ok('AFS::ACL', qw(apply));
can_ok('AFS::ACL', qw(copyacl));
can_ok('AFS::ACL', qw(modifyacl));
can_ok('AFS::ACL', qw(cleanacl));
can_ok('AFS::ACL', qw(empty));
can_ok('AFS::ACL', qw(rights2ascii));
can_ok('AFS::ACL', qw(get_rights));
can_ok('AFS::ACL', qw(nget_rights));
can_ok('AFS::ACL', qw(get_users));
can_ok('AFS::ACL', qw(nget_users));
can_ok('AFS::ACL', qw(length));
can_ok('AFS::ACL', qw(nlength));
can_ok('AFS::ACL', qw(exists));
can_ok('AFS::ACL', qw(nexists));
can_ok('AFS::ACL', qw(add));
code = sscanf(aname, "%d.%d.%d.%d", &b1, &b2, &b3, &b4);
if (code == 4) {
addr = (b1 << 24) | (b2 << 16) | (b3 << 8) | b4;
addr = ntohl(addr); /* convert to host order */
}
else {
th = gethostbyname(aname);
if (!th)
return 0;
/* memcpy(&addr, th->h_addr, sizeof(addr)); */
Copy(th->h_addr, &addr, th->h_length, char);
}
if (addr == htonl(0x7f000001)) { /* local host */
code = gethostname(hostname, MAXHOSTCHARS);
if (code)
return 0;
th = gethostbyname(hostname); /* returns host byte order */
if (!th)
return 0;
/* memcpy(&addr, th->h_addr, sizeof(addr)); */
Copy(th->h_addr, &addr, th->h_length, char);
}
return (addr);
}
/*sends the contents of file associated with <fd> and <blksize> to Rx Stream
* associated with <call> */
int SendFile(ufd, call, blksize)
usd_handle_t ufd;
register struct rx_call *call;
th = (struct hostent *) hostutil_GetHostByName(hostname);
if (!th) {
char buffer[256];
sprintf(buffer, "AFS::BOS: can't find address for host '%s'\n", hostname);
*code = -1;
BSETCODE(code, buffer);
/* printf("bos DEBUG-1: %s\n", buffer); */
return NULL;
}
/* Copy(th->h_addr, &addr, sizeof(afs_int32), afs_int32); */
Copy(th->h_addr, &addr, th->h_length, char);
/* get tokens for making authenticated connections */
if (!rx_initialized) {
/* printf("bos DEBUG rx_Init\n"); */
*code = rx_Init(0);
if (*code) {
char buffer[256];
sprintf(buffer, "AFS::BOS: could not initialize rx (%d)\n", *code);
BSETCODE(code, buffer);
/* printf("bos DEBUG-2\n"); */
CODE:
{
#if defined(AFS_3_4)
not_here("AFS::Utils::get_server_version");
#else
struct sockaddr_in taddr;
struct in_addr hostAddr;
struct hostent *th;
int32 host;
short port_num = htons(port);
int32 length = 64;
int32 code;
char version[64];
int s;
/* lookup host */
if (hostName) {
th = (struct hostent *) hostutil_GetHostByName(hostName);
if (!th) {
warn("rxdebug: host %s not found in host table\n", hostName);
SETCODE(EFAULT);
XSRETURN_UNDEF;
}
/* bcopy(th->h_addr, &host, sizeof(int32)); */
Copy(th->h_addr, &host, th->h_length, char);
}
else
host = htonl(0x7f000001); /* IP localhost */
hostAddr.s_addr = host;
if (verbose)
printf("Trying %s (port %d):\n", inet_ntoa(hostAddr), ntohs(port_num));
s = socket(AF_INET, SOCK_DGRAM, 0);
taddr.sin_family = AF_INET;
taddr.sin_port = 0;
taddr.sin_addr.s_addr = 0;
code = bind(s, (struct sockaddr *) &taddr, sizeof(struct sockaddr_in));
SETCODE(code);
if (code) {
perror("bind");
XSRETURN_UNDEF;
}
code = rx_GetServerVersion(s, host, port_num, length, version);
ST(0) = sv_newmortal();
if (code < 0) {
SETCODE(code);
}
else {
sv_setpv(ST(0), version);
}
#endif
}
struct VldbListByAttributes attributes;
nbulkentries arrayEntries;
register struct nvldbentry *vllist;
int32 nentries;
int j, i, len, verbose = 1;
afs_int32 totalBack=0;
afs_int32 totalFail=0;
int previdx=-1, error, same;
char *ccode, *itp;
int match = 0;
STRLEN prfxlength=0;
SV *regex;
AV *av;
AV *av1 = (AV*)sv_2mortal((SV*)newAV());
AV *av2 = (AV*)sv_2mortal((SV*)newAV());
PPCODE:
{
/* printf("vos-backupsys DEBUG-1 server %s part %s exclude %d noaction %d \n", servername, partition, (int)SvIV(exclude), (int)SvIV(noaction)); */
if (!exclude)
exclude = newSViv(0);
if (!noaction)
}
attributes.partition = apart;
attributes.Mask |= VLLIST_PARTITION;
}
else {
partition = NULL;
}
/* printf("vos-backupsys DEBUG-7\n"); */
/* Check to make sure the prefix and xprefix expressions compile ok */
if (seenprefix && (prfxlength = sv_len(seenprefix)) == 0)
seenprefix = NULL;
/* printf("vos-backupsys DEBUG-7-1 PrfxLen %d\n", prfxlength); */
if (seenprefix && (! (SvTYPE(SvRV(seenprefix)) == SVt_PVAV))) {
VSETCODE(-1, "AFS::VOS: PREFIX not an array reference");
XSRETURN_UNDEF;
}
if (seenprefix) {
av = (AV *) SvRV(seenprefix);
len = av_len(av);
/* printf("vos-backupsys DEBUG-7-2 Len %d\n", len); */
VSETCODE(ccode, buffer);
XSRETURN_UNDEF;
}
}
} /*for loop */
/* printf("vos-backupsys DEBUG-8 RE %s \n", itp); */
}
}
/* printf("vos-backupsys DEBUG-9\n"); */
if (seenxprefix && (prfxlength = sv_len(seenxprefix)) == 0)
seenxprefix = NULL;
/* printf("vos-backupsys DEBUG-10\n"); */
if (seenxprefix && (! (SvTYPE(SvRV(seenxprefix)) == SVt_PVAV))) {
VSETCODE(-1, "AFS::VOS: XPREFIX not an array reference");
XSRETURN_UNDEF;
}
if (seenxprefix) {
/* printf("vos-backupsys DEBUG-11\n"); */
av = (AV *) SvRV(seenxprefix);
afs_int32 saddr;
he = (struct hostent *) hostutil_GetHostByName(host);
if (he == (struct hostent *) 0) {
char buffer[256];
sprintf(buffer, "Can't get host info for '%s'\n", host);
VSETCODE(-1, buffer);
XSRETURN_UNDEF;
}
/*memcpy(&saddr, he->h_addr, 4); */
/* Copy(he->h_addr, &saddr, sizeof(afs_int32), afs_int32); */
Copy(he->h_addr, &saddr, he->h_length, char);
m_attrs.Mask = VLADDR_IPADDR;
m_attrs.ipaddr = ntohl(saddr);
}
else
host = NULL;
m_addrs.bulkaddrs_val = 0;
m_addrs.bulkaddrs_len = 0;
vcode = ubik_Call_New(VL_GetAddrs, cstruct, 0, 0, 0, &m_unique, &nentries, &m_addrs);
afs_int32 vcode = 0;
struct VldbListByAttributes attributes;
nbulkentries arrayEntries;
register struct nvldbentry *vllist;
SV *vol;
char *itp;
afs_int32 nentries;
int j;
char prefix[VOLSER_MAXVOLNAME+1];
int seenprefix=0;
STRLEN volumelength=0;
afs_int32 totalBack=0, totalFail=0, err;
AV *av;
PPCODE:
{
if (prfx && strlen(prfx) == 0)
prfx = NULL;
if (partition && strlen(partition) == 0)
partition = NULL;
if (server && strlen(server) == 0)
server = NULL;
if (volume && (volumelength = sv_len(volume)) == 0)
volume = NULL;
if (volume && (! (SvTYPE(SvRV(volume)) == SVt_PVAV))) {
VSETCODE(-1, "AFS::VLDB: VOLUME not array reference");
XSRETURN_UNDEF;
}
if (volume) { /* -id */
int len;
if (prfx || server || partition) {
src/inc/Test/Builder.pm view on Meta::CPAN
sub maybe_regex {
my ($self, $regex) = @_;
my $usable_regex = undef;
if( ref $regex eq 'Regexp' ) {
$usable_regex = $regex;
}
# Check if it looks like '/foo/'
elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
$usable_regex = length $opts ? "(?$opts)$re" : $re;
};
return($usable_regex)
};
sub _regex_ok {
my($self, $this, $regex, $cmp, $name) = @_;
local $Level = $Level + 1;
my $ok = 0;
src/inc/version/vpp.pm view on Meta::CPAN
my ($left, $right, $swapped) = @_;
unless (ref($right)) { # not an object already
$right = $left->new($right);
}
return $left->{current} <=> $right->{current};
}
sub cmp {
my ($left, $right, $swapped) = @_;
unless (ref($right)) { # not an object already
if (length($right) == 1) { # comparing single character only
return $left->thischar cmp $right;
}
$right = $left->new($right);
}
return $left->currstr cmp $right->currstr;
}
sub bool {
my ($self) = @_;
my $char = $self->thischar;
src/inc/version/vpp.pm view on Meta::CPAN
return 0 if isSPACE($s); # early out
return 1 unless (isALPHA($s) || isDIGIT($s) || $s =~ /[.-]/);
$s++;
}
return 0;
}
sub _un_vstring {
my $value = shift;
# may be a v-string
if ( length($value) >= 3 && $value !~ /[._]/
&& _is_non_alphanumeric($value)) {
my $tvalue;
if ( $] ge 5.008_001 ) {
$tvalue = _find_magic_vstring($value);
$value = $tvalue if length $tvalue;
}
elsif ( $] ge 5.006_000 ) {
$tvalue = sprintf("v%vd",$value);
if ( $tvalue =~ /^v\d+(\.\d+){2,}$/ ) {
# must be a v-string
$value = $tvalue;
}
}
}
return $value;
src/ppport.h view on Meta::CPAN
mfree||5.007002|n
mg_clear|||
mg_copy|||
mg_dup|||
mg_find_mglob|||
mg_findext|5.013008|5.013008|p
mg_find|||
mg_free_type||5.013006|
mg_free|||
mg_get|||
mg_length||5.005000|
mg_localize|||
mg_magical|||
mg_set|||
mg_size||5.005000|
mini_mktime||5.007002|
minus_v|||
missingterm|||
mode_from_discipline|||
modkids|||
more_bodies|||
src/ppport.h view on Meta::CPAN
reg_named_buff_all||5.009005|
reg_named_buff_exists||5.009005|
reg_named_buff_fetch||5.009005|
reg_named_buff_firstkey||5.009005|
reg_named_buff_iter|||
reg_named_buff_nextkey||5.009005|
reg_named_buff_scalar||5.009005|
reg_named_buff|||
reg_node|||
reg_numbered_buff_fetch|||
reg_numbered_buff_length|||
reg_numbered_buff_store|||
reg_qr_package|||
reg_recode|||
reg_scan_name|||
reg_skipcomment|||
reg_temp_copy|||
reganode|||
regatom|||
regbranch|||
regclass_swash||5.009004|
src/ppport.h view on Meta::CPAN
unsharepvn||5.004000|
unwind_handler_stack|||
update_debugger_info|||
upg_version||5.009005|
usage|||
utf16_textfilter|||
utf16_to_utf8_reversed||5.006001|
utf16_to_utf8||5.006001|
utf8_distance||5.006000|
utf8_hop||5.006000|
utf8_length||5.007001|
utf8_mg_len_cache_update|||
utf8_mg_pos_cache_update|||
utf8_to_bytes||5.006001|
utf8_to_uvchr_buf||5.015009|
utf8_to_uvchr||5.007001|
utf8_to_uvuni_buf||5.015009|
utf8_to_uvuni||5.007001|
utf8n_to_uvchr|||
utf8n_to_uvuni||5.007001|
utilize|||
src/ppport.h view on Meta::CPAN
yylex|||
yyparse|||
yyunlex|||
yywarn|||
);
if (exists $opt{'list-unsupported'}) {
my $f;
for $f (sort { lc $a cmp lc $b } keys %API) {
next unless $API{$f}{todo};
print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
}
exit 0;
}
# Scan for possible replacement candidates
my(%replace, %need, %hints, %warnings, %depends);
my $replace = 0;
my($hint, $define, $function);
src/ppport.h view on Meta::CPAN
/* Older perls (<=5.003) lack AvFILLp */
#ifndef AvFILLp
# define AvFILLp AvFILL
#endif
#ifndef ERRSV
# define ERRSV get_sv("@",FALSE)
#endif
/* Hint: gv_stashpvn
* This function's backport doesn't support the length parameter, but
* rather ignores it. Portability can only be ensured if the length
* parameter is used for speed reasons, but the length can always be
* correctly computed from the string argument.
*/
#ifndef gv_stashpvn
# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
#endif
/* Replace: 1 */
#ifndef get_cv
# define get_cv perl_get_cv
#endif
src/ppport.h view on Meta::CPAN
#endif
#define my_strlcat DPPP_(my_my_strlcat)
#define Perl_my_strlcat DPPP_(my_my_strlcat)
#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
Size_t
DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
{
Size_t used, length, copy;
used = strlen(dst);
length = strlen(src);
if (size > 0 && used < size - 1) {
copy = (length >= size - used) ? size - used - 1 : length;
memcpy(dst + used, src, copy);
dst[used + copy] = '\0';
}
return used + length;
}
#endif
#endif
#if !defined(my_strlcpy)
#if defined(NEED_my_strlcpy)
static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
static
#else
extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
#endif
#define my_strlcpy DPPP_(my_my_strlcpy)
#define Perl_my_strlcpy DPPP_(my_my_strlcpy)
#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
Size_t
DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
{
Size_t length, copy;
length = strlen(src);
if (size > 0) {
copy = (length >= size) ? size - 1 : length;
memcpy(dst, src, copy);
dst[copy] = '\0';
}
return length;
}
#endif
#endif
#ifndef PERL_PV_ESCAPE_QUOTE
# define PERL_PV_ESCAPE_QUOTE 0x0001
#endif
#ifndef PERL_PV_PRETTY_QUOTE
# define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE