AFS
view release on metacpan or search on metacpan
* added patch for OpenAFS to create "PIC" type system libraries on
64-bit platforms
* compiles with OpenAFS system libraries version 1.4.X on 32-bit and
on 64-bit platforms
* added installation description for 64-bit platforms
* released the BOS methods
- addhost
- removehost
- adduser
- removeuser
- setrestart
* updated POD documentation of AFS::VLDB
updated argument description for VOLUME in several
methods: "(volume name or volume ID number)"
* fixed method AFS::VOS->create
* extended method AFS::VOS->dump: added "omitdir" option
* added new method AFS::ACL->is_clean
* modified AFS::ACL->cleanacl: uses method "is_clean" to check if
there is anything to do
* method AFS::VOS->listvolume provides also the values "copyDate",
"backupDate", and "accessDate"
gunzip AFS-<version>.tar.gz
tar xvf AFS-<version>.tar
'cd' into that directory, make, test and install the modules.
You have to specify the location of the AFS system
libraries. While running the 'perl Makefile.PL' step you will be
prompted for the location of the AFS system libraries. If you
want to avoid that query, you should specify the environment
variable 'AFSPATH' before you start [1].
If your AFS system type is not yet known by the make file because
you can't run the "fs sysname" command, you can specify the
environment variable 'AFS_SYSNAME' before you start [2].
This is the sequence of commands to build the modules:
cd AFS-<version>
[1] this step is optional
setenv AFSPATH 'path_to_the_AFS_system_libraries' # tcsh-shell
export AFSPATH='path_to_the_AFS_system_libraries' # sh-shell
[2] this step is optional
gunzip AFS-<version>.tar.gz
tar xvf AFS-<version>.tar
cd openafs-1.4.X
patch < AFS-<version>/openafs-pic.patch
make clean
make
make install
Now you have created the additional PIC type system libraries for
OpenAFS 1.4.X and you can start building the AFS modules.
BUILDING & INSTALLING
Building the modules is straightforward. The AFS module bundle is
distributed as a single gzipped tar archive file:
AFS-<version>.tar.gz
Unpack the archive to create an AFS installation directory:
gunzip AFS-<version>.tar.gz
tar xvf AFS-<version>.tar
'cd' into that directory, make, test and install the modules.
You have to specify the location of the AFS system
libraries. While running the 'perl Makefile.PL' step you will be
prompted for the location of the AFS system libraries. If you
want to avoid that query, you should specify the environment
variable 'AFSPATH' before you start [1].
If your AFS system type is not yet known by the make file because
you can't run the "fs sysname" command, you can specify the
environment variable 'AFS_SYSNAME' before you start [2].
This is the sequence of commands to build the modules:
cd AFS-<version>
[1] this step is optional
setenv AFSPATH 'path_to_the_AFS_system_libraries' # tcsh-shell
export AFSPATH='path_to_the_AFS_system_libraries' # sh-shell
[2] this step is optional
LICENCES/COPYING view on Meta::CPAN
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
LICENCES/COPYING view on Meta::CPAN
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
LICENCES/COPYING view on Meta::CPAN
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19yy name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
examples/v2/base/error_test
examples/v2/bos/addhost
examples/v2/bos/addkey
examples/v2/bos/adduser
examples/v2/bos/blockscanner
examples/v2/bos/constructor
examples/v2/bos/create
examples/v2/bos/delete
examples/v2/bos/exec
examples/v2/bos/getlog
examples/v2/bos/getrestart
examples/v2/bos/getrestricted
examples/v2/bos/listhosts
examples/v2/bos/listkeys
examples/v2/bos/listusers
examples/v2/bos/prune
examples/v2/bos/removehost
examples/v2/bos/removekey
examples/v2/bos/removeuser
examples/v2/bos/restart
examples/v2/bos/salvage
examples/v2/bos/setauth
examples/v2/bos/setcellname
examples/v2/bos/setrestart
examples/v2/bos/setrestricted
examples/v2/bos/shutdown
examples/v2/bos/start
examples/v2/bos/startup
examples/v2/bos/status
examples/v2/bos/stop
examples/v2/cell/configdir
examples/v2/cell/expandcell
examples/v2/cell/getcellinfo
examples/v2/cell/localcell
examples/v2/cell/whichcell
examples/v2/cell/wscell
examples/v2/cm/checkconn
examples/v2/cm/checkvolumes
examples/v2/bos/getrestart view on Meta::CPAN
die "Usage: $0 server [cell]\n" if $#ARGV < 0;
$server = shift;
$cellname = shift;
if ($cellname) { $bos = AFS::BOS->new($server, 0, 0, $cellname); }
else { $bos = AFS::BOS->new($server); }
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n" and die;
my ($generalTime, $newBinaryTime) = $bos->getrestart;
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n";
print "Server $server restarts $generalTime\n";
print "Server $server restarts for new binaries $newBinaryTime\n";
$bos->DESTROY;
examples/v2/bos/restart view on Meta::CPAN
$cellname = shift if $nargs > 1;
#warn ">$server< >$instance< >$cellname< \n";
if (defined $instance and $instance =~ / /) { @instance = split / /, $instance; }
if ($cellname) { $bos = AFS::BOS->new($server, 0, 0, $cellname); }
else { $bos = AFS::BOS->new($server); }
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n" and die;
if ($instance eq 'all') { $ok = $bos->restart_all; }
elsif ($instance eq 'bos') { $ok = $bos->restart_bos; }
elsif (@instance) { $ok = $bos->restart(\@instance); }
else { $ok = $bos->restart($instance); }
if ($AFS::CODE) { print "AFS::CODE = $AFS::CODE\n"; }
else { print "OK = $ok \n"; }
$bos->DESTROY;
examples/v2/bos/setrestart view on Meta::CPAN
if (defined $general and !looks_like_number($general)) { warn "$0: GENERAL is not an INTEGER ...\n"; }
else { $general = int($general); }
if (defined $newbinary and !looks_like_number($newbinary)) { warn "$0: NEWBINARY is not an INTEGER ...\n"; }
else { $newbinary = int($newbinary); }
if ($cellname) { $bos = AFS::BOS->new($server, 0, 0, $cellname); }
else { $bos = AFS::BOS->new($server); }
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n" and die;
my $ok = $bos->setrestart($time, $general, $newbinary);
print "Error Code: $AFS::CODE\n" if ($AFS::CODE);
$bos->DESTROY;
examples/v2/bos/start view on Meta::CPAN
$cellname = shift if $nargs > 1;
#warn ">$server< >$instance< >$cellname< \n";
if (defined $instance and $instance =~ / /) { @instance = split / /, $instance; }
if ($cellname) { $bos = AFS::BOS->new($server, 0, 0, $cellname); }
else { $bos = AFS::BOS->new($server); }
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n" and die;
if (@instance) { $ok = $bos->start(\@instance); }
else { $ok = $bos->start($instance); }
if ($AFS::CODE) { print "AFS::CODE = $AFS::CODE\n"; }
else { print "OK = $ok \n"; }
$bos->DESTROY;
examples/v2/bos/startup view on Meta::CPAN
#warn ">$server< >$instance< >$cellname< \n";
if ($instance eq '') { undef $instance; }
if (defined $instance and $instance =~ / /) { @instance = split / /, $instance; }
if ($cellname) { $bos = AFS::BOS->new($server, 0, 0, $cellname); }
else { $bos = AFS::BOS->new($server); }
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n" and die;
if (@instance) { $ok = $bos->startup(\@instance); }
elsif ($instance) { $ok = $bos->startup($instance); }
else { $ok = $bos->startup(); }
if ($AFS::CODE) { print "AFS::CODE = $AFS::CODE\n"; }
else { print "OK = $ok \n"; }
$bos->DESTROY;
examples/v2/bos/status view on Meta::CPAN
#!/usr/local/bin/perl
use blib;
use strict;
use warnings;
use AFS::BOS;
use POSIX qw(strftime);
my ($server, $cellname, $instance, $long, $bos);
my ($nargs, $status, $laststart, $lastexit, @instance);
die "Usage: $0 server [instances [long [cell]]]\n" if $#ARGV < 0;
$nargs = $#ARGV;
$server = shift;
$instance = shift if $nargs > 0;
$long = shift if $nargs > 1;
$cellname = shift if $nargs > 2;
$long = 0 if $nargs == 1;
examples/v2/bos/status view on Meta::CPAN
$bos->DESTROY;
if ($status) {
foreach my $inst (keys %$status) {
if (defined %{$status->{$inst}}) { print "Instance $inst, "; }
else { die "failed to get instance info for \'$inst\' \n"; }
print "currently running normally.\n" if $status->{$inst}->{status};
print "\tAuxiliary status is: $status->{$inst}->{aux_status}\n" if $status->{$inst}->{aux_status};
chomp($laststart = strftime('%d %b %R %Y', localtime($status->{$inst}->{procStartTime})));
chomp($lastexit = strftime('%d %b %R %Y', localtime($status->{$inst}->{lastAnyExit})));
print "\tProcess last started at $laststart\n";
print "\tLast exit at $lastexit\n";
foreach my $val (keys %{$status->{$inst}}) {
if ($val eq 'status') { next; }
elsif ($val eq "aux_status") { next; }
elsif ($val eq "command") {
foreach (@{$status->{$inst}->{$val}}) {
print "\tCommand is $_\n";
}
}
examples/v2/kas/Authenticate view on Meta::CPAN
my $user = AFS::KTC_PRINCIPAL->new(shift);
checkafs('principal new');
my $key = AFS::KTC_EKEY->ReadPassword($user->name."'s Password:");
checkafs('read passwd');
my $kas = AFS::KAS->AuthServerConn(AFS::KTC_TOKEN->nulltoken, &AFS::KA_AUTHENTICATION_SERVICE);
checkafs('server conn');
my $token = $kas->Authenticate($user->name, $user->instance, &AFS::KA_TICKET_GRANTING_SERVICE, $key, time, time+600);
checkafs('authenticate');
print " Token startTime = ", &ctime($token->startTime), "\n";
print " endTime = ", &ctime($token->endTime), "\n";
examples/v2/kas/GetToken view on Meta::CPAN
$user->cell(localcell) if ($user ->cell eq'');
my $key = AFS::KTC_EKEY->ReadPassword($user->name."'s Password:");
my $kas = AFS::KAS->AuthServerConn(AFS::KTC_TOKEN->nulltoken, &AFS::KA_AUTHENTICATION_SERVICE);
my $auth_token = $kas->Authenticate($user->name, $user->instance, &AFS::KA_TICKET_GRANTING_SERVICE, $key, time, time+600);
undef $kas;
$kas = AFS::KAS->AuthServerConn($auth_token, &AFS::KA_TICKET_GRANTING_SERVICE);
my $service = AFS::KTC_PRINCIPAL->new("afs", "", localcell);
my $token = $kas->GetToken($service->name, $service->instance, time, time+600, $auth_token);
print "KAS afs-token: \n";
print "StartTime = ", ctime($token->startTime), "\n";
print "EndTime = ", ctime($token->endTime), "\n";
print "Kvno = ", $token->kvno, "\n";
print "TicketLen = ", $token->ticketLen, "\n";
examples/v2/ktct/FromString view on Meta::CPAN
use warnings;
use AFS::KTC_TOKEN;
use AFS::KTC_PRINCIPAL;
use AFS::Cell qw(localcell);
my $service = AFS::KTC_PRINCIPAL->new("afs","",localcell);
my ($token, $user) = AFS::KTC_TOKEN->GetToken($service);
print "Old Token\n";
print " StartTime = ", $token->startTime, "\n";
print " EndTime = ", $token->endTime, "\n";
print " SessionKey = ", $token->sessionKey, "\n";
print " Kvno = ", $token->kvno, "\n";
print " TicketLen = ", $token->ticketLen, "\n";
#print " Ticket = ", $token->ticket, "\n";
#print " String = ", $token->string, "\n";
my $string = $token->string();
my $newtoken = AFS::KTC_TOKEN->FromString($string) or
die "AFS::KTC_TOKEN->FromString failed!\n";
print "New Token (from String)\n";
print " StartTime = ", $newtoken->startTime, "\n";
print " EndTime = ", $newtoken->endTime, "\n";
print " SessionKey = ", $newtoken->sessionKey, "\n";
print " Kvno = ", $newtoken->kvno, "\n";
print " TicketLen = ", $newtoken->ticketLen, "\n";
#print " Ticket = ", $newtoken->ticket, "\n";
#print " String = ", $newtoken->string, "\n";
examples/v2/ktct/GetAdminToken view on Meta::CPAN
my $admn = shift;
my $admin = AFS::KTC_PRINCIPAL->new($admn);
my $key = AFS::KTC_EKEY->ReadPassword('admin Password:');
my $reason = '';
my $token = AFS::KTC_TOKEN->GetAdminToken($admin, $key, 330, 1, $reason);
print "AFS::CODE = $AFS::CODE (", $AFS::CODE+0,")\n";
if ($reason) { print "reason = $reason\n"; }
print " StartTime = ", ctime($token->startTime), "\n";
print " EndTime = ", ctime($token->endTime), "\n";
examples/v2/ktct/GetServerToken view on Meta::CPAN
my $service = AFS::KTC_PRINCIPAL->new("afs","",$user->cell);
my $token = AFS::KTC_TOKEN->GetServerToken($service, 600);
print "\nCurrent tokens after GetServerToken:\n";
my $index = 0;
while ($service = AFS::KTC_PRINCIPAL->ListTokens($index)) {
print "ID: $index service = ", $service->principal, "\n";
($token, my $client) = AFS::KTC_TOKEN->GetToken($service);
print " client = ", $client->principal, "\n";
print " StartTime = ", ctime($token->startTime), "\n";
print " EndTime = ", ctime($token->endTime), "\n";
print " Kvno = ", $token->kvno, "\n";
print " TicketLen = ", $token->ticketLen, "\n";
}
print "--- END tokens ---\n";
examples/v2/ktct/GetToken view on Meta::CPAN
use AFS::KTC_TOKEN;
use AFS::KTC_PRINCIPAL;
use AFS::Cell qw(localcell);
system "tokens";
my $service = AFS::KTC_PRINCIPAL->new("afs","",localcell);
my ($token, $user) = AFS::KTC_TOKEN->GetToken($service);
print "User = ", $user->principal, "\n";
print " Token StartTime = ", ctime($token->startTime), "\n";
print " EndTime = ", ctime($token->endTime), "\n";
pod/v2/README view on Meta::CPAN
build HTML docs. Unfortunately the perl Makefile.PL
infrastructure won't do this for you automatically. You have to
generate it explicitly. 'cd' into the top directory and 'make'
the HTML documentation. This is the sequence of commands to build
the docs:
cd AFS-2.6.4
perl Makefile.PL ;#(if you have not submitted already)
make html
After this you can start your browser with the file
AFS-2.6.4/lib/AFS.html
and go ahead with reading docs.
pod/v2/afsperlbos.pod view on Meta::CPAN
$bos = AFS::BOS->new('server');
$ok = $bos->addkey(11, 'My Secret');
my ($date, $keys) = $bos->listkeys;
$ok = $bos->removekey([10, 11]);
$ok = $bos->adduser('username');
my @users = $bos->listusers;
$ok = $bos->removeuser('username');
my ($generalTime, $newBinaryTime) = $bos->getrestart;
my ($general, $newbinary, $time) = (1, 0, 'sat 4:00');
$ok = $bos->setrestart($time, $general, $newbinary);
$ok = $bos->startup;
my $status = $bos->status;
$ok = $bos->shutdown;
$ok = $bos->start(['vlserver']);
$ok = $bos->restart(['fs', 'vlserver']);
$ok = $bos->restart_bos;
$ok = $bos->restart_all;
$ok = $bos->stop(['vlserver']);
my $restricted = $bos->getrestricted;
$ok = $bos->setrestricted('on');
$ok = $bos->create('kaserver', 'simple', ['/usr/afs/bin/kaserver']);
$ok = $bos->delete('instance');
$ok = $bos->exec('/sbin/shutdown -r now');
pod/v2/afsperlbos.pod view on Meta::CPAN
C<UserList> file. USER is either a scalar value or a reference to an
array of names. It calls the AFS system library function
I<BOZO_AddSUser>.
=item B<$ok = $bos-E<gt>create(PROCESS, TYPE, COMMAND [, NOTIFIER]);>
=item B<$ok = $bos-E<gt>create(PROCESS, TYPE, \@COMMAND [, NOTIFIER]);>
Creates a server PROCESS entry in the local C<BosConfig> file on the
server machine, sets the process's status to I<Run> in the
C<BosConfig> file and in memory, and starts the process. TYPE
specifies the process's type. Acceptable values are: 'simple', 'cron',
and 'fs'. COMMAND is either a scalar value or an array reference
containing the commands the BOS Server should run to start the
process. NOTIFIER specifies the complete pathname of a program that
the BOS Server invokes when the process terminates. It calls the AFS
system library function I<BOZO_CreateBnode>.
=item B<$ok = $bos-E<gt>delete(INSTANCE);>
=item B<$ok = $bos-E<gt>delete(\@INSTANCE);>
Deletes the entry INSTANCE from the local C<BosConfig> file. INSTANCE
is either a scalar value or a reference to an array of instance names.
pod/v2/afsperlbos.pod view on Meta::CPAN
Executes the indicated COMMAND on the BOS server machine. It calls
the AFS system library function I<BOZO_Exec>.
=item B<@logfile = $bos-E<gt>getlog(LOGFILE);>
Returns an array with the contents of the specified LOGFILE from the
BOS server. It calls the AFS system library function
I<StartBOZO_GetLog>.
=item B<($GTIME, $BTIME) = $bos-E<gt>getrestart;>
Returns the restart times GTIME and BTIME from the local C<BosConfig>
file. GTIME is the general restart time at which the BOS Server
process automatically restarts itself. BTIME is the binary restart
time at which the BOS Server automatically restarts any process for
which the time stamp on the binary file in the local C</usr/afs/bin>
directory is later than the last restart time for the process. It
calls the AFS system library function I<BOZO_GetRestartTime>.
=item B<$restricted = $bos-E<gt>getrestricted;>
Returns the current I<restricted mode> of the BOS server. Return value
1 means I<restriced mode> enabled, 0 means disabled. This method is
only available under OpenAFS if the AFS system libraries were compiled
with the I<Restricted Mode Option>. It calls the AFS system library
function I<BOZO_GetRestrictedMode>.
=item B<($CELL, $HOSTS) = $bos-E<gt>listhosts;>
pod/v2/afsperlbos.pod view on Meta::CPAN
system library function I<BOZO_DeleteKey>.
=item B<$ok = $bos-E<gt>removeuser(USER);>
=item B<$ok = $bos-E<gt>removeuser(\@USER);>
Removes the privileged USER from the local C<UserList> file. USER is
either a scalar value or a reference to an array of users. It calls
the AFS system library function I<BOZO_DeleteSuser>.
=item B<$ok = $bos-E<gt>restart_bos;>
Stops and immediately restarts all AFS server processes, including the
BOS Server. A new BOS Server starts immediately, and it starts a new
instance of each process that is marked with the I<run status flag>.
It calls the AFS system library function I<BOZO_ReBozo>.
=item B<$ok = $bos-E<gt>restart_all;>
Stops and immediately restarts all AFS server processes, except the
BOS Server, that are marked with the I<run status flag>.
It calls the AFS system library function I<BOZO_RestartAll>.
=item B<$ok = $bos-E<gt>restart(SERVER);>
=item B<$ok = $bos-E<gt>restart(\@SERVER);>
Stops and immediately restarts the SERVER processes on the server
machine, regardless of its I<run status flag>. SERVER is either a
scalar value or a reference to an array of server names.
It calls the AFS system library function I<BOZO_Restart>.
=item B<$ok = $bos-E<gt>salvage([PARTITION] ...));>
B<NOT YET RELEASED>
??? The argument list must be completed CORRECTLY !!!
Salvages (restores internal consistency to) one or more volumes on the
file server machine
pod/v2/afsperlbos.pod view on Meta::CPAN
C<CellServDB>. It calls the AFS system library function
I<BOZO_SetCellName>.
B<Cautions>
Use this method only when installing the cell's first AFS server
machine. The I<AFS Quick Beginnings> documentation explains how to
copy over the C<ThisCell> and C<CellServDB> files from this or another
appropriate machine during installation of additional server machines.
=item B<$ok = $bos-E<gt>setrestart(TIME [, GENERAL [, NEWBINARY]]);>
Sets the restart TIME at which the BOS Server restarts processes. Set
GENERAL to 1 (default 0) to set the restart time of the BOS Server to
TIME. This TIME is once per week. Set NEWBINARY to 1 (default 0) to
set the binary restart time. The TIME is once per day. Only one of
the arguments GENERAL and NEWBINARY can be set. It calls the AFS
system library function I<BOZO_SetRestartTime>.
=item B<$ok = $bos-E<gt>setrestricted(MODE);>
Enables (MODE = 1) or disables (MODE = 0) the I<restricted mode> for
the BOS server which disables certain bosserver functionality. This
method is only available under OpenAFS if the AFS system libraries were
compiled with the I<Restricted Mode Option>. It calls the AFS system
library function I<BOZO_SetRestrictedMode>.
=item B<$ok = $bos-E<gt>shutdown([SERVER, ] [WAIT]);>
pod/v2/afsperlbos.pod view on Meta::CPAN
Stops on the server machine either all running server processes,
excluding the BOS server process or the SERVER process. SERVER is
either a scalar value or a reference to an array of process names. It
does not change its status flag in the local C<BosConfig> file but
only in the BOS Server's memory. Set WAIT to 1 (default 0) to delay
the program flow until all processes actually stop. Otherwise the
method returns almost immediately even if all processes are not
stopped. It calls the AFS system library function I<BOZO_WaitAll>.
=item B<$ok = $bos-E<gt>start(SERVER);>
=item B<$ok = $bos-E<gt>start(\@SERVER);>
Sets the I<status flag> for each SERVER process to I<Run> in the local
C<BosConfig> file and in the BOS Server's memory on the server
machine, then starts it. If the SERVER process is already running,
the only effect is to guarantee that the status flag is I<Run>; it
does not restart the process. SERVER is either a scalar value or a
reference to an array of process names. It calls the AFS system
library function I<BOZO_SetStatus>.
=item B<$ok = $bos-E<gt>startup([SERVER]);>
=item B<$ok = $bos-E<gt>startup([\@SERVER]);>
Starts on the server machine either all server processes not currently
running but marked with the I<run status flag> in the local
C<BosConfig> file or the process SERVER even if its status flag in the
C<BosConfig> file is I<NotRun>. SERVER is either a scalar value or a
reference to an array of process names. The I<run status flag> in the
local C<BosConfig> file will not be changed. It calls the AFS system
library function I<BOZO_StartupAll> or I<BOZO_SetTStatus>.
=item B<$STATUS = $bos-E<gt>status([LONG [, SERVER]]);>
pod/v2/afsperlcell.pod view on Meta::CPAN
=cut
# does not work properly, return value $cell is not set properly ???
# =item B<($cell, @servers) = getcell(INDEX [,IP]);>
# Displays the list of the database server machines that the Cache Manager
# stores in kernel memory for its home cell and foreign cells.
# Iterates through the Cache Manager's internal cell configuration,
# using INDEX as an index. The index starts at 0. $AFS::CODE will
# be set to a non-zero value when passed an invalid index. If IP is
# set to 1 then IP addresses will be returned instead of hostnames.
# Displays each database server machine's IP address rather than hostname.
=item B<($cell @servers) = getcellinfo([CELL [,IP]]);>
Gets information on CELL (default NULL) using CellServDB. If IP (default
0) is set to 1 then IP addresses will be returned instead of hostnames.
=item B<$cellname = localcell;>
pod/v2/afsperlktct.pod view on Meta::CPAN
=head1 SYNOPSIS
use AFS::KTC_TOKEN;
use AFS::KTC_PRINCIPAL;
use AFS::KTC_EKEY;
use AFS::Cell qw(localcell);
my $token = AFS::KTC_TOKEN->nulltoken;
print "StartTime = ", $token->startTime, "\n";
print "EndTime = ", $token->endTime, "\n";
print "SessionKey = ", $token->sessionKey, "\n";
print "Kvno = ", $token->kvno, "\n";
print "TicketLen = ", $token->ticketLen, "\n";
print "Ticket = ", $token->ticket, "\n";
print "String = ", $token->string, "\n";
my $index = 0;
my $service = AFS::KTC_PRINCIPAL->ListTokens($index);
print "service = ", $service->principal, "\n";
($token, my $user) = AFS::KTC_TOKEN->GetToken($service);
print " client = ", $user -> principal, "\n";
print " StartTime = ", $token->startTime, "\n";
print " EndTime = ", $token->endTime, "\n";
print " SessionKey = ", $token->sessionKey, "\n";
print " Kvno = ", $token->kvno, "\n";
print " TicketLen = ", $token->ticketLen, "\n";
print " Ticket = ", $token->ticket, "\n";
print " String = ", $token->string, "\n";
$service = AFS::KTC_PRINCIPAL->new("afs","",localcell);
($token, $user) = AFS::KTC_TOKEN->GetToken($service);
AFS::KTC_TOKEN->ForgetAllTokens();
AFS::KTC_TOKEN->SetToken($service, $token, $user, 0);
my $string = $token->string;
$token = AFS::KTC_TOKEN->FromString($string);
print " StartTime = ", $token->startTime, "\n";
print " EndTime = ", $token->endTime, "\n";
my $user = AFS::KTC_PRINCIPAL->new('nog','',localcell);
my $key = AFS::KTC_EKEY->ReadPassword('nog Password:');
my $ok = AFS::KTC_TOKEN->GetAuthToken($user, $key, 600);
$service = AFS::KTC_PRINCIPAL->new("afs","",localcell);
$token = AFS::KTC_TOKEN->GetServerToken($service, 600, 1);
$user = AFS::KTC_PRINCIPAL->new('nog','',localcell);
pod/v2/afsperlktct.pod view on Meta::CPAN
=head1 COMPATIBILITY
B<This release does NOT support any features and interfaces
from version 1.>
=head1 OBJECT ATTRIBUTES
=over 4
=item B<startTime>
Starting date of the token.
=item B<endTime>
Expiration date of the token.
=item B<sessionKey>
Session encryption key of the token.
pod/v2/afsperlktct.pod view on Meta::CPAN
Returns a recovered token from STRING. This STRING was previously
generated with the instance method '$token-E<gt>string'.
=item B<ATTRIBUTES ACCESS>
=item S< >
=item B<$token-E<gt>ATTRIBUTE;>
Retrieves the value for the specified object attribute, where ATTRIBUTE
is one of the above listed object attributes (e.g. C<startTime>).
=item B<INSTANCE METHODS>
=item S< >
=item B<$token-E<gt>string;>
Returns the whole token as a C<string>.
=back
return;
}
static void GetServerAndPart(entry, voltype, server, part, previdx)
struct nvldbentry *entry;
afs_int32 *server, *part;
int voltype;
int *previdx;
{
int i, istart, vtype;
*server = -1;
*part = -1;
/* Doesn't check for non-existance of backup volume */
if ((voltype == RWVOL) || (voltype == BACKVOL)) {
vtype = ITSRWVOL;
istart = 0; /* seach the entire entry */
}
else {
vtype = ITSROVOL;
/* Seach from beginning of entry or pick up where we left off */
istart = ((*previdx < 0) ? 0 : *previdx + 1);
}
for (i = istart; i < entry->nServers; i++) {
if (entry->serverFlags[i] & vtype) {
*server = entry->serverNumber[i];
*part = entry->serverPartition[i];
*previdx = i;
return;
}
}
/* Didn't find any, return -1 */
if (code) {
char buf[256];
sprintf(buf, "AFS::BOS: failed to get status for instance '%s' (%s)\n",
aname, em(code));
BSETCODE(code, buf);
}
else {
/* printf("currently ", aname); */
/* if (temp == BSTAT_NORMAL) printf("running normally.\n"); */
/* else if (temp == BSTAT_SHUTDOWN) printf("shutdown.\n"); */
/* else if (temp == BSTAT_STARTINGUP) printf("starting up.\n"); */
/* else if (temp == BSTAT_SHUTTINGDOWN) printf("shutting down.\n"); */
safe_hv_store(stats, "status", 6, newSViv(temp), 0);
if (buffer[0] != 0) {
/* printf(" Auxiliary status is: %s.\n", buffer); */
safe_hv_store(stats, "aux_status", 10, newSVpv(buffer, strlen(buffer)), 0);
}
}
/* are we done yet? */
if (!aint32p)
return 0;
if (istatus.procStartTime) {
/* printf(" Process last started at %s (%d proc starts)\n", */
/* DateOf(istatus.procStartTime), istatus.procStarts); */
safe_hv_store(stats, "procStartTime", 13, newSViv(istatus.procStartTime), 0);
safe_hv_store(stats, "procStarts", 10, newSViv(istatus.procStarts), 0);
}
if (istatus.lastAnyExit) {
/* printf(" Last exit at %s\n", DateOf(istatus.lastAnyExit)); */
safe_hv_store(stats, "lastAnyExit", 11, newSViv(istatus.lastAnyExit), 0);
}
if (istatus.lastErrorExit) {
is1 = is2 = is3 = is4 = (char *) 0;
sprintf(pbuffer, " -Residencies %u", mrafsParm.OptResidencies);
strcat(tbuffer, pbuffer);
}
parms[0] = tbuffer;
parms[1] = "now"; /* when to do it */
code = BOZO_CreateBnode(aconn, "cron", "salvage-tmp", parms[0], parms[1],
parms[2], parms[3], parms[4], notifier);
if (code) {
char buffer[256];
sprintf(buffer, "AFS::BOS: failed to start 'salvager' (%s)\n", em(code));
BSETCODE(code, buffer);
goto done;
}
/* now wait for bnode to disappear */
while (1) {
#ifdef AFS_PTHREAD_ENV
sleep(5);
#else
IOMGR_Sleep(5);
#endif /* AFS_PTHREAD_ENV*/
safe_hv_store(stats, "reserved1", 9, newSViv(kas->reserved1), 0);
safe_hv_store(stats, "reserved2", 9, newSViv(kas->reserved2), 0);
safe_hv_store(stats, "reserved3", 9, newSViv(kas->reserved3), 0);
safe_hv_store(stats, "reserved4", 9, newSViv(kas->reserved4), 0);
/* dynamic stats */
safe_hv_store(dstats, "minor_version", 13, newSViv(kad->minor_version), 0);
safe_hv_store(dstats, "host", 4, newSViv(kad->host), 0);
safe_hv_store(dstats, "start_time", 10, newSViv(kad->start_time), 0);
safe_hv_store(dstats, "hashTableUtilization", 20, newSViv(kad->hashTableUtilization), 0);
safe_hv_store(dstats, "string_checks", 13, newSViv(kad->string_checks), 0);
safe_hv_store(dstats, "reserved1", 9, newSViv(kad->reserved1), 0);
safe_hv_store(dstats, "reserved2", 9, newSViv(kad->reserved2), 0);
safe_hv_store(dstats, "reserved3", 9, newSViv(kad->reserved3), 0);
safe_hv_store(dstats, "reserved4", 9, newSViv(kad->reserved4), 0);
safe_hv_store(dstats, "Authenticate_requests", 21, newSViv(kad->Authenticate.requests), 0);
safe_hv_store(dstats, "Authenticate_aborts", 19, newSViv(kad->Authenticate.aborts), 0);
safe_hv_store(dstats, "ChangePassword_requests", 23,
newSViv(kad->ChangePassword.requests), 0);
safe_hv_store(stats, "lastUTGS", 8, newSVpv(ka->lastUTGS, strlen(ka->lastUTGS)), 0);
safe_hv_store(stats, "lastAdmin", 9, newSVpv(ka->lastAdmin, strlen(ka->lastAdmin)), 0);
safe_hv_store(stats, "lastTGSServer", 13,
newSVpv(ka->lastTGSServer, strlen(ka->lastTGSServer)), 0);
safe_hv_store(stats, "lastUTGSServer", 14,
newSVpv(ka->lastUTGSServer, strlen(ka->lastUTGSServer)), 0);
safe_hv_store(stats, "minorVersion", 12, newSViv(ka->minorVersion), 0);
safe_hv_store(stats, "host", 4, newSViv(ka->host), 0);
safe_hv_store(stats, "startTime", 9, newSViv(ka->startTime), 0);
safe_hv_store(stats, "noAuth", 6, newSViv(ka->noAuth), 0);
safe_hv_store(stats, "lastTrans", 9, newSViv(ka->lastTrans), 0);
safe_hv_store(stats, "nextAutoCPW", 11, newSViv(ka->nextAutoCPW), 0);
safe_hv_store(stats, "updatesRemaining", 16, newSViv(ka->updatesRemaining), 0);
safe_hv_store(stats, "dbHeaderRead", 12, newSViv(ka->dbHeaderRead), 0);
safe_hv_store(stats, "dbVersion", 9, newSViv(ka->dbVersion), 0);
safe_hv_store(stats, "dbFreePtr", 9, newSViv(ka->dbFreePtr), 0);
safe_hv_store(stats, "dbEofPtr", 8, newSViv(ka->dbEofPtr), 0);
safe_hv_store(stats, "dbKvnoPtr", 9, newSViv(ka->dbKvnoPtr), 0);
CODE:
{
if (t && t != &the_null_token) safefree(t);
# SETCODE(0); this spoils the ERROR code
RETVAL = 1;
}
OUTPUT:
RETVAL
int32
ktct_startTime(t)
AFS::KTC_TOKEN t
PPCODE:
{
EXTEND(sp,1);
PUSHs(sv_2mortal(newSViv(t->startTime)));
}
int32
ktct_endTime(t)
AFS::KTC_TOKEN t
PPCODE:
{
EXTEND(sp,1);
PUSHs(sv_2mortal(newSViv(t->endTime)));
}
}
SETCODE(code);
done:
RETVAL = (code == 0);
}
OUTPUT:
RETVAL
int32
bos__restart(self, bosserver=0, all=0, object=NULL)
AFS::BOS self
int bosserver
int all
SV *object
PREINIT:
int32 code = 0;
CODE:
{
if (bosserver) {
if (object != NULL) {
char buffer[256];
sprintf(buffer,
"AFS::BOS: can't specify both 'bosserver' and specific servers to restart.\n");
BSETCODE(-1, buffer);
RETVAL = 0;
goto done;
}
code = BOZO_ReBozo(self);
if (code) {
char buffer[256];
sprintf(buffer, "AFS::BOS: failed to restart bosserver (%s)\n", em(code));
BSETCODE(code, buffer);
}
RETVAL = (code == 0);
goto done;
}
if (object == NULL) {
if (all) {
code = BOZO_RestartAll(self);
if (code) {
char buffer[256];
sprintf(buffer, "AFS::BOS: failed to restart servers (%s)\n", em(code));
BSETCODE(code, buffer);
}
}
else {
char buffer[256];
sprintf(buffer, "AFS::BOS: To restart all processes please specify 'all'\n");
BSETCODE(-1, buffer);
}
RETVAL = (code == 0);
goto done;
}
else {
if (all) {
char buffer[256];
sprintf(buffer, "AFS::BOS: Can't use 'all' along with individual instances\n");
BSETCODE(-1, buffer);
}
av = (AV *) SvRV(object);
len = av_len(av);
if (len != -1) {
for (i = 0; i <= len && i < 6; i++) {
sv = *av_fetch(av, i, 0);
if (sv) {
instance = (char *) safemalloc(BOZO_BSSIZE);
instance = SvPV(sv, namelen);
code = BOZO_Restart(self, instance);
if (code) {
char buffer[256];
sprintf(buffer, "AFS::BOS: failed to restart instance %s (%s)\n",
instance, em(code));
BSETCODE(code, buffer);
}
}
} /* for loop */
SETCODE(code);
RETVAL = (code == 0);
}
}
}
done:
;
}
OUTPUT:
RETVAL
int32
bos_setrestart(self, time, general=Nullsv, newbinary=Nullsv)
AFS::BOS self
char *time
SV * general
SV * newbinary
PREINIT:
int32 code = 0, count = 0;
struct ktime restartTime;
afs_int32 type;
int igeneral;
int inewbinary;
CODE:
{
if (!general) {
general = newSViv(0);
}
if (!SvIOKp(general)) {
char buffer[256];
if (igeneral) {
count++;
type = 1;
}
if (inewbinary) {
count++;
type = 2;
}
if (count > 1) {
char buffer[80];
sprintf(buffer, "AFS::BOS: can't specify more than one restart time at a time\n");
BSETCODE(-1, buffer);
goto done;
}
if (count == 0)
type = 1; /* by default set general restart time */
if (code = ktime_ParsePeriodic(time, &restartTime)) {
char buffer[240];
sprintf(buffer, "AFS::BOS: failed to parse '%s' as periodic restart time(%s)\n",
time, em(code));
BSETCODE(code, buffer);
goto done;
}
code = BOZO_SetRestartTime(self, type, &restartTime);
if (code) {
char buffer[240];
sprintf(buffer, "AFS::BOS: failed to set restart time at server (%s)\n", em(code));
BSETCODE(code, buffer);
goto done;
}
code = 0;
SETCODE(code);
done:
RETVAL = (code == 0);
}
OUTPUT:
RETVAL
void
bos_getrestart(self)
AFS::BOS self
PREINIT:
int32 code = 0;
struct ktime generalTime, newBinaryTime;
char messageBuffer[256];
PPCODE:
{
code = BOZO_GetRestartTime(self, 1, &generalTime);
if (code) {
char buffer[256];
sprintf(buffer, "AFS::BOS: failed to retrieve restart information (%s)\n", em(code));
BSETCODE(code, buffer);
XSRETURN_UNDEF;
}
code = BOZO_GetRestartTime(self, 2, &newBinaryTime);
if (code) {
char buffer[256];
sprintf(buffer, "AFS::BOS: failed to retrieve restart information (%s)\n", em(code));
BSETCODE(code, buffer);
XSRETURN_UNDEF;
}
code = ktime_DisplayString(&generalTime, messageBuffer);
if (code) {
char buffer[256];
sprintf(buffer, "AFS::BOS: failed to decode restart time (%s)\n", em(code));
BSETCODE(code, buffer);
strcpy(messageBuffer, "");
}
XPUSHs(sv_2mortal(newSVpv(messageBuffer, strlen(messageBuffer))));
code = ktime_DisplayString(&newBinaryTime, messageBuffer);
if (code) {
char buffer[256];
sprintf(buffer, "AFS::BOS: failed to decode restart time (%s)\n", em(code));
BSETCODE(code, buffer);
strcpy(messageBuffer, "");
}
XPUSHs(sv_2mortal(newSVpv(messageBuffer, strlen(messageBuffer))));
XSRETURN(2);
}
void
bos_listusers(self)
}
code = rx_EndCall(tcall, error);
#if (tcall)
# Safefree(tcall);
/* fall through into cleanup code */
XSRETURN(num);
}
int32
bos__start(self, object=NULL)
AFS::BOS self
SV * object
PREINIT:
int32 code = 0;
CODE:
{
if (object && (! (SvTYPE(SvRV(object)) == SVt_PVAV))) {
code = -1;
BSETCODE(code, "AFS::BOS: SERVER not an array reference\n");
goto done;
if (len != -1) {
for (i = 0; i <= len; i++) {
sv = *av_fetch(av, i, 0);
if (sv) {
/* instance = (char *) safemalloc(BOZO_BSSIZE); */
Newx(instance, BOZO_BSSIZE, char);
instance = SvPV(sv, namelen);
code = BOZO_SetStatus(self, instance, BSTAT_NORMAL);
if (code) {
char buffer[256];
sprintf(buffer, "AFS::BOS: failed to start instance %s (%s)\n",
instance, em(code));
BSETCODE(code, buffer);
goto done;
}
/*if (instance) */
/* Safefree(instance); */
}
} /* for loop */
}
}
SETCODE(code);
done:
RETVAL = (code == 0);
}
OUTPUT:
RETVAL
int32
bos__startup(self, object=NULL)
AFS::BOS self
SV * object
PREINIT:
int32 code = 0;
CODE:
{
if (object && (! (SvTYPE(SvRV(object)) == SVt_PVAV))) {
code = -1;
BSETCODE(code, "AFS::BOS: SERVER not an array reference\n");
goto done;
if (len != -1) {
for (i = 0; i <= len; i++) {
sv = *av_fetch(av, i, 0);
if (sv) {
/* instance = (char *) safemalloc(BOZO_BSSIZE); */
Newx(instance, BOZO_BSSIZE, char);
instance = SvPV(sv, namelen);
code = BOZO_SetTStatus(self, instance, BSTAT_NORMAL);
if (code) {
char buffer[256];
sprintf(buffer, "AFS::BOS: failed to start instance %s (%s)\n",
instance, em(code));
BSETCODE(code, buffer);
goto done;
}
/*if (instance) */
/* Safefree(instance); */
}
} /* for loop */
}
}
else {
code = BOZO_StartupAll(self);
if (code) {
char buffer[256];
sprintf(buffer, "AFS::BOS: failed to startup servers (%s)\n", em(code));
BSETCODE(code, buffer);
goto done;
}
}
SETCODE(code);
done:
RETVAL = (code == 0);
}
OUTPUT:
sprintf(buffer,
"AFS::BOS: failed to wait for file server shutdown, continuing.\n");
BSETCODE(code, buffer);
}
}
/* now do the salvage operation */
/* fprintf(stderr, "Starting salvage of everything.\n"); */
rc = DoSalvage(self, (char *) 0, (char *) 0, outName, showlog, parallel, tmpDir,
orphans);
if (curGoal == BSTAT_NORMAL) {
/* fprintf(stderr, "AFS::BOS: restarting fs.\n"); */
code = BOZO_SetTStatus(self, "fs", BSTAT_NORMAL);
if (code) {
char buffer[256];
sprintf(buffer, "AFS::BOS: failed to restart 'fs' (%s)\n", em(code));
BSETCODE(code, buffer);
goto done;
}
}
if (rc) {
code = rc;
goto done;
}
}
else if (!volume) {
sprintf(buffer,
"AFS::BOS: failed to wait for file server shutdown, continuing.\n");
BSETCODE(code, buffer);
}
}
/* now do the salvage operation */
/* fprintf(stderr, "Starting salvage of partition %s.\n", partition); */
rc = DoSalvage(self, partition, (char *) 0,
outName, showlog, parallel, tmpDir, orphans);
if (curGoal == BSTAT_NORMAL) {
/* fprintf(stderr, "AFS::BOS: restarting fs.\n"); */
code = BOZO_SetTStatus(self, "fs", BSTAT_NORMAL);
if (code) {
char buffer[256];
sprintf(buffer, "AFS::BOS: failed to restart 'fs' (%s)\n", em(code));
BSETCODE(code, buffer);
goto done;
}
}
if (rc) {
code = rc;
goto done;
}
}
else {
{
int32 code;
code = ka_ChangePassword(name, instance, server, oldkey, newkey);
SETCODE(code);
EXTEND(sp, 1);
PUSHs(sv_2mortal(newSViv(code == 0)));
}
void
kas_ka_GetToken(server,name,instance,start,end,auth_token,auth_domain="")
AFS::KAS server
char * name
char * instance
int32 start
int32 end
AFS::KTC_TOKEN auth_token
char * auth_domain
PPCODE:
{
int32 code;
struct ktc_token *t;
#if defined(AFS_3_4)
#else
char *cname = NULL;
char *cinst = NULL;
char *cell = NULL;
#endif
t = (struct ktc_token *) safemalloc(sizeof(struct ktc_token));
#if defined(AFS_3_4)
code = ka_GetToken(name, instance, server, start, end, auth_token, auth_domain, t);
#else
if (cell == 0) {
cell = internal_GetLocalCell(&code);
if (code)
XSRETURN_UNDEF;
}
code = ka_GetToken(name, instance, cell, cname, cinst, server,
start, end, auth_token, auth_domain, t);
#endif
if (code == 0) {
SV *st;
EXTEND(sp, 1);
st = sv_newmortal();
sv_setref_pv(st, "AFS::KTC_TOKEN", (void *) t);
PUSHs(st);
XSRETURN(1);
}
else {
char buffer[256];
sprintf(buffer, "AFS::KTC_TOKEN: ");
KSETCODE(code, buffer);
safefree(t);
XSRETURN_UNDEF;
}
}
void
kas_ka_Authenticate(server,name,instance,service,key,start,end,pwexpires=-1)
AFS::KAS server
char * name
char * instance
int32 service
AFS::KTC_EKEY key
int32 start
int32 end
int32 pwexpires
PPCODE:
{
int32 code;
int32 pw;
struct ktc_token *t;
#if defined(AFS_3_4)
#else
char *cell = NULL;
#endif
t = (struct ktc_token *) safemalloc(sizeof(struct ktc_token));
#if defined(AFS_3_4)
code = ka_Authenticate(name, instance, server, service, key, start, end, t, &pw);
#else
if (cell == 0) {
cell = internal_GetLocalCell(&code);
if (code)
XSRETURN_UNDEF;
}
code = ka_Authenticate(name, instance, cell, server, service, key, start, end, t, &pw);
#endif
if (code == 0) {
SV *st;
EXTEND(sp, 1);
st = sv_newmortal();
sv_setref_pv(st, "AFS::KTC_TOKEN", (void *) t);
PUSHs(st);
if (pwexpires != -1)
sv_setiv(ST(7), (IV) pw);
XSRETURN(1);
src/BOS/BOS.pm view on Meta::CPAN
$commands[0] = $command;
if ($notifier) { $self->_create($process, $type, \@commands, $notifier); }
else { $self->_create($process, $type, \@commands); }
}
else {
carp "AFS::BOS->create: not a valid COMMAND input ...\n";
return 0;
}
}
sub restart {
my $self = shift;
if ($#_ == 0 and ref($_[0]) eq 'ARRAY') { # SERVER is array ref
$self->_restart(0, 0, @_);
}
elsif ($#_ == 0 and ref($_[0]) eq '') { # SERVER is scalar
my @server;
$server[0] = shift;
$self->_restart(0, 0, \@server);
}
else {
carp "AFS::BOS->restart: not a valid input ...\n";
return undef;
}
}
sub restart_all {
my $self = shift;
$self->_restart(0, 1);
}
sub restart_bos {
my $self = shift;
$self->_restart(1);
}
sub start {
my $self = shift;
if ($#_ == 0 and ref($_[0]) eq 'ARRAY') { # SERVER is array ref
$self->_start(@_);
}
elsif ($#_ == 0 and ref($_[0]) eq '') { # SERVER is scalar
my @server;
$server[0] = shift;
$self->_start(\@server);
}
else {
carp "AFS::BOS->start: not a valid input ...\n";
return undef;
}
}
sub startup {
my $self = shift;
if ($#_ == -1) { # no input given
$self->_startup();
}
elsif ($#_ == 0 and ref($_[0]) eq 'ARRAY') { # SERVER is array ref
$self->_startup(@_);
}
elsif ($#_ == 0 and ref($_[0]) eq '') { # SERVER is scalar
my @server;
$server[0] = shift;
$self->_startup(\@server);
}
else {
carp "AFS::BOS->startup: not a valid input ...\n";
return undef;
}
}
sub status {
my $self = shift;
if ($#_ > 0 and ! defined $_[1]) { $_[1] = ''; } # INSTANCE is not defined
if (ref($_[1]) eq 'ARRAY' or $#_ <= 0) { # INSTANCE is array ref
src/BOS/t/BOS.t view on Meta::CPAN
is(leak_test(), 1210, 'bos leak_test');
$bos = AFS::BOS->new($server);
my ($cell, $hostlist) = $bos->listhosts;
is($cell, $l_cell, 'bos-listhost: Cellname OK');
ok(defined $$hostlist[0], 'bos->listhost: Host list OK');
my @users = $bos->listusers;
ok(defined $users[0], 'bos->listusers: User list OK');
$bos->setrestart('14:00', 'a', 0);
like($AFS::CODE, qr/Flag "general" should be numeric/, 'bos->setrestart(time no_integer newbinary)');
$bos->setrestart('14:00', 0, 'a');
like($AFS::CODE, qr/Flag "newbinary" should be numeric/, 'bos->setrestart(time general no_integer)');
$bos->setrestart('14:00', 1, 1);
like($AFS::CODE, qr/specify more than one restart time/, 'bos->setrestart(time general=1 newbinary=1)');
my ($generalTime, $newBinaryTime) = $bos->getrestart;
ok(defined $generalTime, 'bos->getrestart: GeneralTime OK');
ok(defined $newBinaryTime, 'bos->getrestart: NewBinaryTime OK');
my $result = $bos->status(0, [ 'fs', ]) || $bos->status(0, [ 'dafs', ]);
isa_ok($result->{fs} || $result->{dafs}, 'HASH', 'bos->status OK');
my %h = ( nog => 1 );
$bos->adduser(\%h);
like($AFS::CODE, qr/USER not an array reference/, 'bos->adduser(HASH)');
$bos->addhost('host', 'a');
like($AFS::CODE, qr/Flag "clone" should be numeric/, 'bos->addhost(host no_integer)');
src/BOS/t/BOS.t view on Meta::CPAN
like($AFS::CODE, qr/USER not an array reference/, 'bos->removeuser(HASH)');
my $user = 'z';
$bos->removeuser($user);
SKIP: {
skip "You lack rights for this test", 1
if $AFS::CODE =~ /you are not authorized for this operation/;
like($AFS::CODE, qr/no such user/, 'bos->removeuser(unknown user)');
}
can_ok('AFS::BOS', qw(restart_bos));
can_ok('AFS::BOS', qw(restart_all));
can_ok('AFS::BOS', qw(restart));
can_ok('AFS::BOS', qw(setauth));
can_ok('AFS::BOS', qw(setrestricted));
can_ok('AFS::BOS', qw(shutdown));
can_ok('AFS::BOS', qw(start));
can_ok('AFS::BOS', qw(startup));
can_ok('AFS::BOS', qw(stop));
$bos->DESTROY;
ok(! defined $bos, 'bos->DESTROY');
sub leak_test {
my $count = 0;
my $verb = 1;
while(1) {
$count++;
src/KTC_TOKEN/KTC_TOKEN.pm view on Meta::CPAN
}
sub ForgetAllTokens {
my $class = shift;
AFS::ktc_ForgetAllTokens;
}
# struct ktc_token {
# afs_int32 startTime;
# afs_int32 endTime;
# struct ktc_encryptionKey sessionKey;
# short kvno; /* XXX UNALIGNED */
# int ticketLen;
# char ticket[MAXKTCTICKETLEN];
# };
1;
src/inc/Test/Builder.pm view on Meta::CPAN
lock($Curr_Test);
if( defined $num ) {
unless( $Have_Plan ) {
require Carp;
Carp::croak("Can't change the current test number without a plan!");
}
$Curr_Test = $num;
if( $num > @Test_Results ) {
my $start = @Test_Results ? $#Test_Results + 1 : 0;
for ($start..$num-1) {
my %result;
share(%result);
%result = ( ok => 1,
actual_ok => undef,
reason => 'incrementing test number',
type => 'unknown',
name => undef
);
$Test_Results[$_] = \%result;
}
src/inc/version/vpp.pm view on Meta::CPAN
while (isDIGIT($d)) {
$d++;
if ($d eq '.' && isDIGIT($d-1)) {
if ($alpha) {
return BADVERSION($s,$errstr,"Invalid version format (underscores before decimal)");
}
if ($strict) {
return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions must begin with 'v')");
}
$d = $s; # start all over again
$qv = TRUE;
goto dotted_decimal_version;
}
if ($d eq '_') {
if ($strict) {
return BADVERSION($s,$errstr,"Invalid version format (no underscores)");
}
if ( $alpha ) {
return BADVERSION($s,$errstr,"Invalid version format (multiple underscores)");
}
src/inc/version/vpp.pm view on Meta::CPAN
$$ssaw_decimal = $saw_decimal;
}
if (defined $salpha) {
$$salpha = $alpha;
}
return $d;
}
sub scan_version {
my ($s, $rv, $qv) = @_;
my $start;
my $pos;
my $last;
my $errstr;
my $saw_decimal = 0;
my $width = 3;
my $alpha = FALSE;
my $vinf = FALSE;
my @av;
$s = new charstar $s;
src/inc/version/vpp.pm view on Meta::CPAN
\$width, \$alpha);
if ($errstr) {
# 'undef' is a special case and not an error
if ( $s ne 'undef') {
use Carp;
Carp::croak($errstr);
}
}
$start = $s;
if ($s eq 'v') {
$s++;
}
$pos = $s;
if ( $qv ) {
$$rv->{qv} = $qv;
}
if ( $alpha ) {
$$rv->{alpha} = $alpha;
src/inc/version/vpp.pm view on Meta::CPAN
{
# this is atoi() that delimits on underscores
my $end = $pos;
my $mult = 1;
my $orev;
# the following if() will only be true after the decimal
# point of a version originally created with a bare
# floating point number, i.e. not quoted in any way
#
if ( !$qv && $s > $start && $saw_decimal == 1 ) {
$mult *= 100;
while ( $s < $end ) {
$orev = $rev;
$rev += $s * $mult;
$mult /= 10;
if ( (abs($orev) > abs($rev))
|| (abs($rev) > $VERSION_MAX )) {
warn("Integer overflow in version %d",
$VERSION_MAX);
$s = $end - 1;
src/inc/version/vpp.pm view on Meta::CPAN
while ($len-- > 0) {
push @av, 0;
}
}
# need to save off the current version string for later
if ( $vinf ) {
$$rv->{original} = "v.Inf";
$$rv->{vinf} = 1;
}
elsif ( $s > $start ) {
$$rv->{original} = $start->currstr($s);
if ( $qv && $saw_decimal == 1 && $start ne 'v' ) {
# need to insert a v to be consistent
$$rv->{original} = 'v' . $$rv->{original};
}
}
else {
$$rv->{original} = '0';
push(@av, 0);
}
# And finally, store the AV in the hash
src/ppport.h view on Meta::CPAN
_invlist_invert_prop|||
_invlist_invert|||
_invlist_len|||
_invlist_populate_swatch|||
_invlist_search|||
_invlist_subtract|||
_invlist_union_maybe_complement_2nd|||
_invlist_union|||
_is_uni_FOO||5.017008|
_is_uni_perl_idcont||5.017008|
_is_uni_perl_idstart||5.017007|
_is_utf8_FOO||5.017008|
_is_utf8_mark||5.017008|
_is_utf8_perl_idcont||5.017008|
_is_utf8_perl_idstart||5.017007|
_new_invlist_C_array|||
_new_invlist|||
_pMY_CXT|5.007003||p
_swash_inversion_hash|||
_swash_to_invlist|||
_to_fold_latin1|||
_to_uni_fold_flags||5.013011|
_to_upper_title_latin1|||
_to_utf8_fold_flags||5.015006|
_to_utf8_lower_flags||5.015006|
src/ppport.h view on Meta::CPAN
av_tindex||5.017009|
av_top_index||5.017009|
av_undef|||
av_unshift|||
ax|||n
bad_type_gv|||
bad_type_pv|||
bind_match|||
block_end|||
block_gimme||5.004000|
block_start|||
blockhook_register||5.013003|
boolSV|5.004000||p
boot_core_PerlIO|||
boot_core_UNIVERSAL|||
boot_core_mro|||
bytes_cmp_utf8||5.013007|
bytes_from_utf8||5.007001|
bytes_to_uni|||n
bytes_to_utf8||5.006001|
call_argv|5.006000||p
src/ppport.h view on Meta::CPAN
dXSTARG|5.006000||p
deb_curcv|||
deb_nocontext|||vn
deb_stack_all|||
deb_stack_n|||
debop||5.005000|
debprofdump||5.005000|
debprof|||
debstackptrs||5.007003|
debstack||5.007003|
debug_start_match|||
deb||5.007003|v
defelem_target|||
del_sv|||
delete_eval_scope|||
delimcpy||5.004000|n
deprecate_commaless_var_list|||
despatch_signals||5.007001|
destroy_matcher|||
die_nocontext|||vn
die_sv||5.013001|
src/ppport.h view on Meta::CPAN
keyword|||
leave_scope|||
lex_bufutf8||5.011002|
lex_discard_to||5.011002|
lex_grow_linestr||5.011002|
lex_next_chunk||5.011002|
lex_peek_unichar||5.011002|
lex_read_space||5.011002|
lex_read_to||5.011002|
lex_read_unichar||5.011002|
lex_start||5.009005|
lex_stuff_pvn||5.011002|
lex_stuff_pvs||5.013005|
lex_stuff_pv||5.013006|
lex_stuff_sv||5.011002|
lex_unstuff||5.011002|
listkids|||
list|||
load_module_nocontext|||vn
load_module|5.006000||pv
localize|||
src/ppport.h view on Meta::CPAN
package_version|||
package|||
packlist||5.008001|
pad_add_anon||5.008001|
pad_add_name_pvn||5.015001|
pad_add_name_pvs||5.015001|
pad_add_name_pv||5.015001|
pad_add_name_sv||5.015001|
pad_alloc_name|||
pad_alloc|||
pad_block_start|||
pad_check_dup|||
pad_compname_type||5.009003|
pad_findlex|||
pad_findmy_pvn||5.015001|
pad_findmy_pvs||5.015001|
pad_findmy_pv||5.015001|
pad_findmy_sv||5.015001|
pad_fixup_inner_anons|||
pad_free|||
pad_leavemy|||
src/ppport.h view on Meta::CPAN
put_latin1_charclass_innards|||
pv_display|5.006000||p
pv_escape|5.009004||p
pv_pretty|5.009004||p
pv_uni_display||5.007003|
qerror|||
qsortsvu|||
re_compile||5.009005|
re_croak2|||
re_dup_guts|||
re_intuit_start||5.019001|
re_intuit_string||5.006000|
re_op_compile|||
readpipe_override|||
realloc||5.007002|n
reentrant_free||5.019003|
reentrant_init||5.019003|
reentrant_retry||5.019003|vn
reentrant_size||5.019003|
ref_array_or_hash|||
refcounted_he_chain_2hv|||
src/ppport.h view on Meta::CPAN
skipspace_flags|||
softref2xv|||
sortcv_stacked|||
sortcv_xsub|||
sortcv|||
sortsv_flags||5.009003|
sortsv||5.007003|
space_join_names_mortal|||
ss_dup|||
stack_grow|||
start_force|||
start_glob|||
start_subparse||5.004000|
stdize_locale|||
strEQ|||
strGE|||
strGT|||
strLE|||
strLT|||
strNE|||
str_to_version||5.006000|
strip_return|||
strnEQ|||
strnNE|||
study_chunk|||
sub_crush_depth|||
sublex_done|||
sublex_push|||
sublex_start|||
sv_2bool_flags||5.013006|
sv_2bool|||
sv_2cv|||
sv_2io|||
sv_2iuv_common|||
sv_2iuv_non_preserve|||
sv_2iv_flags||5.009001|
sv_2iv|||
sv_2mortal|||
sv_2num|||
src/ppport.h view on Meta::CPAN
if (exists $opt{'api-info'}) {
my $f;
my $count = 0;
my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
for $f (sort { lc $a cmp lc $b } keys %API) {
next unless $f =~ /$match/;
print "\n=== $f ===\n\n";
my $info = 0;
if ($API{$f}{base} || $API{$f}{todo}) {
my $base = format_version($API{$f}{base} || $API{$f}{todo});
print "Supported at least starting from perl-$base.\n";
$info++;
}
if ($API{$f}{provided}) {
my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
print "Support by $ppport provided back to perl-$todo.\n";
print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
print "\n$hints{$f}" if exists $hints{$f};
print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
$info++;
src/ppport.h view on Meta::CPAN
imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
sv = va_arg(*args, SV*);
}
}
{
const line_t ocopline = PL_copline;
COP * const ocurcop = PL_curcop;
const int oexpect = PL_expect;
#if (PERL_BCDVERSION >= 0x5004000)
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
veop, modname, imop);
#elif (PERL_BCDVERSION > 0x5003000)
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
veop, modname, imop);
#else
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
modname, imop);
#endif
PL_expect = oexpect;
PL_copline = ocopline;
PL_curcop = ocurcop;
}
}
#endif
#endif
src/ppport.h view on Meta::CPAN
#endif
#define load_module DPPP_(my_load_module)
#define Perl_load_module DPPP_(my_load_module)
#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
void
DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
{
va_list args;
va_start(args, ver);
vload_module(flags, name, ver, &args);
va_end(args);
}
#endif
#endif
#ifndef newRV_inc
# define newRV_inc(sv) newRV(sv) /* Replace */
#endif
src/ppport.h view on Meta::CPAN
return rv;
}
#endif
#endif
/* Hint: newCONSTSUB
* Returns a CV* as of perl-5.7.1. This return value is not supported
* by Devel::PPPort.
*/
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
#if defined(NEED_newCONSTSUB)
static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
static
#else
extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
#endif
#ifdef newCONSTSUB
# undef newCONSTSUB
src/ppport.h view on Meta::CPAN
line_t oldline = PL_curcop->cop_line;
PL_curcop->cop_line = D_PPP_PL_copline;
PL_hints &= ~HINT_BLOCK_SCOPE;
if (stash)
PL_curstash = PL_curcop->cop_stash = stash;
newSUB(
#if (PERL_BCDVERSION < 0x5003022)
start_subparse(),
#elif (PERL_BCDVERSION == 0x5003022)
start_subparse(0),
#else /* 5.003_23 onwards */
start_subparse(FALSE, 0),
#endif
newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
);
PL_hints = oldhints;
PL_curcop->cop_stash = old_cop_stash;
PL_curstash = old_curstash;
src/ppport.h view on Meta::CPAN
#endif
#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
void
DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
va_list args;
va_start(args, pat);
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#ifdef PERL_IMPLICIT_CONTEXT
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
src/ppport.h view on Meta::CPAN
#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
void
DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
{
dTHX;
va_list args;
va_start(args, pat);
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#endif
/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
src/ppport.h view on Meta::CPAN
#endif
#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
void
DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#ifdef PERL_IMPLICIT_CONTEXT
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
src/ppport.h view on Meta::CPAN
#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
void
DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
{
dTHX;
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#endif
/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
src/ppport.h view on Meta::CPAN
#if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
void
DPPP_(my_warner)(U32 err, const char *pat, ...)
{
SV *sv;
va_list args;
PERL_UNUSED_ARG(err);
va_start(args, pat);
sv = vnewSVpvf(pat, &args);
va_end(args);
sv_2mortal(sv);
warn("%s", SvPV_nolen(sv));
}
#define warner Perl_warner
#define Perl_warner_nocontext Perl_warner
src/ppport.h view on Meta::CPAN
#endif
/*
* The grok_* routines have been modified to use warn() instead of
* Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
* which is why the stack variable has been renamed to 'xdigit'.
*/
#ifndef grok_bin
#if defined(NEED_grok_bin)
static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_bin
# undef grok_bin
#endif
#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
#define Perl_grok_bin DPPP_(my_grok_bin)
#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
UV
DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_2 = UV_MAX / 2;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
/* strip off leading b or 0b.
src/ppport.h view on Meta::CPAN
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Binary number > 0b11111111111111111111111111111111 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#endif
#ifndef grok_hex
#if defined(NEED_grok_hex)
static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_hex
# undef grok_hex
#endif
#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
#define Perl_grok_hex DPPP_(my_grok_hex)
#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
UV
DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_16 = UV_MAX / 16;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
const char *xdigit;
if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
src/ppport.h view on Meta::CPAN
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Hexadecimal number > 0xffffffff non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#endif
#ifndef grok_oct
#if defined(NEED_grok_oct)
static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_oct
# undef grok_oct
#endif
#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
#define Perl_grok_oct DPPP_(my_grok_oct)
#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
UV
DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_8 = UV_MAX / 8;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
for (; len-- && *s; s++) {
/* gcc 2.95 optimiser not smart enough to figure that this subtraction
src/ppport.h view on Meta::CPAN
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Octal number > 037777777777 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
src/ppport.h view on Meta::CPAN
#define Perl_my_snprintf DPPP_(my_my_snprintf)
#if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
int
DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
{
dTHX;
int retval;
va_list ap;
va_start(ap, format);
#ifdef HAS_VSNPRINTF
retval = vsnprintf(buffer, len, format, ap);
#else
retval = vsprintf(buffer, format, ap);
#endif
va_end(ap);
if (retval < 0 || (len > 0 && (Size_t)retval >= len))
Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
return retval;
}
src/ppport.h view on Meta::CPAN
#define my_sprintf DPPP_(my_my_sprintf)
#define Perl_my_sprintf DPPP_(my_my_sprintf)
#if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
int
DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
{
va_list args;
va_start(args, pat);
vsprintf(buffer, pat, args);
va_end(args);
return strlen(buffer);
}
#endif
#endif
#ifdef NO_XSLOCKS
# ifdef dJMPENV
src/ppport.h view on Meta::CPAN
if (escaped != NULL)
*escaped= pv - str;
return SvPVX(dsv);
}
#endif
#endif
#ifndef pv_pretty
#if defined(NEED_pv_pretty)
static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
static
#else
extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
#endif
#ifdef pv_pretty
# undef pv_pretty
#endif
#define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
#define Perl_pv_pretty DPPP_(my_pv_pretty)
#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
char *
DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
const STRLEN max, char const * const start_color, char const * const end_color,
const U32 flags)
{
const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
STRLEN escaped;
if (!(flags & PERL_PV_PRETTY_NOCLEAR))
sv_setpvs(dsv, "");
if (dq == '"')
sv_catpvs(dsv, "\"");
else if (flags & PERL_PV_PRETTY_LTGT)
sv_catpvs(dsv, "<");
if (start_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
if (end_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
if (dq == '"')
sv_catpvs(dsv, "\"");
else if (flags & PERL_PV_PRETTY_LTGT)
sv_catpvs(dsv, ">");
( run in 0.845 second using v1.01-cache-2.11-cpan-fd5d4e115d8 )