AFS
view release on metacpan or search on metacpan
NOTICE:
* This release does not support AFS system libraries version 3.4 or
version 3.5
* Two of the hash key names returned by the VLDB method "listaddrs" have
changed in version 2.4.1 (see POD doku AFS::VLDB)
* This release does not support any features and interfaces from
AFSPerl "version 1"
User-visible changes:
* compiles with OpenAFS system libraries version 1.4.12
* fixed method AFS::VLDB->listvldb: fixed segmentation error
* improved Makefile.PL script for Perl 5.10.0 and "threaded PIC" libraries
* updated example scripts for the modules AFS::VLDB and AFS::VOS
* improved test drivers for the modules AFS::VLDB and AFS::VOS;
Developer-visible changes:
* convertet all VERSION variables to "dotted decimal version" with leading "v"
* changed argument type from "int" to "string" for method AFS::VLDB->removeaddr
NOTICE:
* This release does not support AFS system libraries version 3.4 or
version 3.5
* Two of the hash key names returned by the VLDB method "listaddrs" have
changed in version 2.4.1 (see POD doku AFS::VLDB)
* This release does not support any features and interfaces from
AFSPerl "version 1"
User-visible changes:
* fixed method AFS::KAS->getentry: fixed return value for passwd_reuse
* fixed method AFS::VLDB->listvldb: fixed segmentation error
* updated example scripts for the modules AFS::KAS
* fixed Makefile.PL to recognize Transarc/IBM system libraries
Developer-visible changes:
* cleaned up Makefile.PL
Version 2.6.0 (released 27 Oct 2008, revision 888)
User-visible changes:
* improved several test drivers;
* updated example scripts for the modules AFS:VOS, AFS::VLDB,
AFS::Cell, AFS::CM, AFS::FS, AFS::BOS, and AFS::KTC_EKEY
* improved POD documentation for AFS::FS and AFS
* POD documentation gets installed automatically
* fixed method AFS::VLDB->listaddrs: lists now all servers
* fixed method AFS::VOS->listvol: returns correct name and volid when
volume is busy
* fixed method AFS::VOS->listvldb: returns proper "release" strings
* improved error messages when OpenAFS configuration files are missing
* compiles now with OpenAFS system libraries newer than 1.4.4
* improved Makefile.PL script to avoid interactive queries
Developer-visible changes:
* modified initialization of the "cell" variable for "fs" functions
* cleaned up source code and error handling for "vos" functions, "vldb"
functions, and "bos" functions
Version 2.4.0 (released 20 Feb 2006, revision 777)
NOTICE:
* This release does not support AFS system libraries version 3.4 or
version 3.5
Version 2.2.3 (released 17 Feb 2005, revision 679)
NOTICE:
* This release does not support AFS system libraries version 3.4 or
version 3.5
User-visible changes:
* now supports Perl "threaded" version on several platforms
* fixed method AFS::VOS->backupsys: fixed segmentation error and
added some error handling
* fixed method AFS::VLDB->delentry: added some error handling
Developer-visible changes:
* modified AFS.xs functions "SendFile", "ReceiveFile",
and "DoSalvage" to handle "threaded" and "unthreaded" case
* modified AFS.xs: added dummy functions for "threaded" case
* redesigned the computing of the VERSION numbers
version 3.5
* This release does ONLY work with Perl "unthreaded" versions (this
is true for all versions 2.2.X)
User-visible changes:
* improved most test drivers;
* included checks for Perl "unthreaded" version;
Developer-visible changes:
* modified AFS.xs function "isafs": patched error handling
Version 2.2.1 (released 09 March 2004, revision 594)
NOTICE: This release does not support AFS system libraries
version 3.4 or version 3.5
User-visible changes:
appreciate a note to tell me how you got on. Although I am
particularly interested to hear about any problems you encounter
when building the system, I would still like to hear from you even
if you don't.
Things I particularly would like to know
* The Operating system name and version, e.g. SunOS 4.1.3
* Architecture, e.g. Solaris
* C compiler, e.g. gcc
* Where there any warnings/errors printed by the C compiler? If so
please send the exact output if possible.
* The Perl version
* The version of the AFS system libraries
KNOWN PROBLEMS
Under SunOS, several people have encountered problems while compiling
and installing the AFS module bundle.
appreciate a note to tell me how you got on. Although I am
particularly interested to hear about any problems you encounter
when building the system, I would still like to hear from you even
if you don't.
Things I particularly would like to know
* The Operating system name and version, e.g. SunOS 4.1.3
* Architecture, e.g. Solaris
* C compiler, e.g. gcc
* Where there any warnings/errors printed by the C compiler? If so
please send the exact output if possible.
* The Perl version
* The version of the AFS system libraries
KNOWN PROBLEMS
Under SunOS, several people have encountered problems while compiling
and installing the AFS module bundle.
LICENCES/IBM-LICENCE view on Meta::CPAN
5. NO WARRANTY
EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS
PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY
WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY
OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely
responsible for determining the appropriateness of using and
distributing the Program and assumes all risks associated with its
exercise of rights under this Agreement, including but not limited to
the risks and costs of program errors, compliance with applicable
laws, damage to or loss of data, programs or equipment, and
unavailability or interruption of operations.
6. DISCLAIMER OF LIABILITY
EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR
ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING
WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
examples/v2/acl/apply
examples/v2/acl/ascii2rights
examples/v2/acl/cleanacl
examples/v2/acl/copyacl
examples/v2/acl/crights
examples/v2/acl/is_clean
examples/v2/acl/modifyacl
examples/v2/acl/retrieve
examples/v2/acl/rights2ascii
examples/v2/base/constant
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/README view on Meta::CPAN
HOW TO USE THE EXAMPLES
All scripts in "v2" are designed that you can run them without
prior installation of the AFS module bundle. After you have
performed the steps "perl Makefile.pl", "make", and eventually
"make test" you can run these test scripts. Just step into the
different subdirectories and run the available examples, e.g:
cd AFS-2.6.4/examples/v2/base
./error_test
examples/v2/base/error_test view on Meta::CPAN
#!/usr/local/bin/perl
use blib;
use strict;
use warnings;
use AFS qw (error_message);
print error_message(&AFS::PRNOMORE),"\n";
print error_message(180502),"\n";
print error_message(0),"\n";
print error_message(13),"\n";
examples/v2/bos/prune view on Meta::CPAN
elsif ($what eq 'old') {
# warn "prune old \n";
$ok = $bos->prune(0, 0, 1); # delete .OLD files
}
elsif ($what eq 'core') {
# warn "prune core \n";
$ok = $bos->prune(0, 0, 0, 1); # delete CORE files
}
else {
# warn "prune nothing \n";
$ok = $bos->prune; # nothing specified ... give error message
}
print "Error Code: $AFS::CODE\n" if ($AFS::CODE);
#print "Status: $ok \n";
$bos->DESTROY;
examples/v2/bos/salvage view on Meta::CPAN
my $localauth = 0;
$ok = $bos->salvage($partition, $volume);
print "Error Code: $AFS::CODE\n" if ($AFS::CODE);
print "Something went wrong\n" unless $ok;
exit;
## some error conditions:
$ok = $bos->salvage(); # no parameter is not allowed
$ok = $bos->salvage('/vicepz'); # partition does not exist
$ok = $bos->salvage('/vicepa', 'does.not.exist'); # volume does not exist
($partition, $volume) = ('', '');
$all = 1;
$ok = $bos->salvage($partition, $volume, $all);
print "Error Code: $AFS::CODE\n" if ($AFS::CODE);
print "Something went wrong\n" unless $ok;
pod/v2/afsperl.pod view on Meta::CPAN
=item * Access to the AFS structure ktc_encryptionkey
Methods that deal with encryption keys related to tokens. See
L<AFS::KTC_EKEY>.
=item * Access to shared utility routines
Utility functions for the AFS module bundle which are not part of any
AFS command suite (i.e, the setpag command). See L<AFS::Utils>.
=item * Access to basic AFS functions and to AFS error codes
Basic functions like raising a Perl exception when any AFS function call
fails (useful for debugging) or retrieving the status value of the last
AFS function call. See L<AFS::Base>.
=back
=head1 PREREQUISITES
=over 4
pod/v2/afsperlbase.pod view on Meta::CPAN
#------------------------------------------------------------------------------
=head1 NAME
B<AFS> - Basic functions and variables of the B<AFS> module
=head1 SYNOPSIS
use AFS qw (
afsok checkafs constant
error_message raise_exception
);
my $acl = getacl($path);
if (afsok) ....
checkafs('getacl');
$old = raise_exception(1);
... make some calls you want to raise exceptions for
... there is an error
raise_exception($old);
$mess = error_message($code);
$value = constant('PRIDEXIST'); # value = 267265
$value = &AFS::PRIDEXIST; # value = 267265, preferred method
if ($AFS::CODE eq "User or group doesn't exist") ....
if ($AFS::CODE == &AFS::PRNOENT) ....
=head1 DESCRIPTION
This document describes the special variables and convenience functions
available from the AFS module. You can convert error codes into error
messages. It is possible to activate exception handling for the AFS
system calls. You can retrieve the values for AFS constants. Any
function required must by explicitly listed by the C<use> statement to be
exported into the calling package.
=head1 COMPATIBILITY
B<This release does NOT support any features and interfaces
from version 1.>
=head1 Special Variables
=over 4
=item B<$AFS::CODE>
The special variable $AFS::CODE contains the status value of the last AFS
function call. A non-zero value indicates an error occurred, while a
zero indicates success. This variable is magical. (like the $! variable)
If you reference it as a string you will get an error message, and
if you reference it as a numeric value (use the int() function or add 0 to
it) it will equal the numeric error code.
=back
=head1 EXPORTS
=head2 Standard Exports
none
=head2 Optional Exports
The following functions will be exported into your namespace if you
specifically ask that they be imported.
=over 4
=item B<checkafs(CHECKPOINT);>
Convenience function that calls die and prints an error message if
$AFS::CODE is not equal to 0. Used mainly for debugging.
=item B<if (afsok) { ... }>
Convenience function that returns true if $AFS::CODE is equal to 0
=item B<$cur_raise_flg = raise_exception([NEW]);>
If NEW is set to 1, then a Perl exception will be raised whenever
an error is returned from an AFS function call. This is used mainly for
debugging and testing.
=item B<$msg = error_message(NUM_CODE);>
Converts numeric code NUM_CODE into an error string.
=item B<$val = constant(NAME);>
Converts a constant NAME (i.e, #define) into scaler. Returns undef for
unknown constants.
=item B<$val = &AFS::CONSTANT;>
All values referenced through the constant function can be referenced as
functions in the AFS package. This is the preferred way of accessing
pod/v2/afsperlbos.pod view on Meta::CPAN
=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.
Before using this method, issue the stop method to stop the process
and set its status flag in the BosConfig file to NotRun. The delete
method fails with an error message if a process's status flag is Run.
It calls the AFS system library function I<BOZO_DeleteBnode>.
=item B<$ok = $bos-E<gt>exec(COMMAND);>
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
pod/v2/afsperlcell.pod view on Meta::CPAN
=item B<$dir = configdir;>
=item B<$ok = configdir(DIR);>
Gets or sets the configuration directory for an AFS server/client
machine. Default is C</usr/vice/etc>.
=item B<$cellname = expandcell(CELL);>
Expands CELL to the fully qualified cellname. Returns undef on error.
=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.
pod/v2/afsperlcell.pod view on Meta::CPAN
# 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;>
Returns the cellname of the local cell. Returns undef on error.
=item B<$cellname = whichcell(PATH [,FOLLOW]);>
Returns the name of the cell in which the volume that houses PATH
resides. Returns undef and sets CODE on error.
=item B<$cellname = wscell;>
Returns the name of the local machine's home cell.
=back
=head1 CURRENT AUTHOR
Norbert E. Gruener E<lt>nog@MPA-Garching.MPG.deE<gt>
pod/v2/afsperlfs.pod view on Meta::CPAN
=item B<$ok = isafs(PATH [,FOLLOW]);>
Returns 1 if PATH is in AFS.
=item B<$volume = lsmount(PATH [,FOLLOW]);>
Returns the volume name for which PATH is a mount point. The last
element in PATH must be an actual name, not a shorthand notation such
as one or two periods (. or ..). If PATH is not a mount point or is
not in AFS it returns undef and an error code is set.
=item B<$ok = mkmount(PATH, VOLUME [, RW [, CELL]]);>
Creates a given mount point PATH for the VOLUME. If RW (default 0) is
set to 1 it creates a read/write mount point otherwise a regular mount
point. If CELL (default NULL) is set, the cell indicator appears in the
mount point.
=item B<$ok = rmmount(PATH);>
Removes a given mount point PATH. If it was not successful it returns 0
and an error code is set.
=item B<$ok = setquota(PATH, QUOTA [,FOLLOW]);>
Sets the QUOTA (maximum possible size) of the read/write volume that
contains PATH.
=item B<@hosts = whereis(PATH [,IP [,FOLLOW]]);>
Returns the name of each file server machine housing PATH. If IP
(default 0) is set to 1 then IP addresses will be returned instead of
pod/v2/afsperlkas.pod view on Meta::CPAN
misc_auth_bytes modification_time modification_user
user_expiration
It calls the AFS system library function 'KAM_GetEntry'.
=item B<($num_admins, $kasstats, $kadstats) = $kas-E<gt>getstats;>
=item B<($num_admins, $kasstats, $kadstats) = $kas-E<gt>KAM_GetStats(VERSION);>
Returns statistics about the AuthServer and its database. If VERSION
does not match that used by the server, the call returns an error
code. The return values are references to the hash tables containing
the values from the C structures C<kasstats> and C<kadstats>. This
call requires a connection encrypted with an AdminTicket. Possible
values for VERSION are
&AFS::KAMAJORVERSION
It calls the AFS system library function 'KAM_Getstats'.
=item B<$token = $kas-E<gt>GetToken(SNAME, SINST, STIME, ETIME, AUTH_TOKEN [, AUTH_CELL]);>
pod/v2/afsperlkas.pod view on Meta::CPAN
=item B<($name, $inst) = $kas-E<gt>listentry(PREV, INDX, COUNT);>
=item B<($name, $inst) = $kas-E<gt>KAM_ListEntry(PREV, INDX, COUNT);>
Returns the name and instance of an entry in the database. It provides
a way to step through all the entries in the database. The first call
should be made with previous index PREV set to zero. The method updates
COUNT, which is an estimate of the number of entries remaining to be
returned, and INDX, which should be passed in as previous index on the
next call. A negative COUNT or a nonzero return code indicates that an
error occurred. A zero INDX means there were no more entries. A zero
COUNT means the last entry has been returned. This call requires a
connection encrypted with an AdminTicket. It calls the AFS system
library function 'KAM_ListEntry'.
=item B<$rkey = $kas-E<gt>randomkey;>
=item B<$rkey = $kas-E<gt>KAM_GetRandomKey;>
Returns a random DES key (an instance of AFS::KTC_EKEY) and is preferred
over a calling routine just inventing a key. It calls the AFS system
pod/v2/afsperlktck.pod view on Meta::CPAN
returned as an AFS::KTC_EKEY object. It calls the AFS system library
function 'ka_StringToKey'.
=item B<CLASS METHODS>
=item S< >
=item B<$string = AFS::KTC_EKEY-E<gt>UserReadPassword(PROMPT [, REASON]);>
Prints out a PROMPT and reads a string from the terminal, turning off
echoing. This string is returned. On error the error message is
returned in REASON. It calls the AFS system library function
'ka_UserReadPassword'.
=item B<ATTRIBUTES ACCESS>
=item S< >
=item B<$key-E<gt>string;>
Returns the whole encryption key as a string.
pod/v2/afsperlktct.pod view on Meta::CPAN
requires that you already possess a TGT (method GetAuthToken). It
calls the AFS system library function 'ka_GetServerToken'.
=item B<$token = AFS::KTC_TOKEN-E<gt>GetAdminToken(USER, EKEY, LIFE [, NEWTK [, REASON]]);>
Creates an administration token for the specified USER. It saves the
token in the memory (kernel token cache) and additionally it returns
the token. EKEY contains the encryption key and LIFE indicates how
long the token will be valid (in seconds, given in 5 minute
intervals). If NEWTK is set to 1 (default), then the function should
get a new token if necessary. On error the error message is returned
in REASON. USER must be an instance of AFS::KTC_PRINCIPAL and EKEY an
instance of AFS::KTC_EKEY. It calls the AFS system library function
'ka_GetAdminToken'.
=item B<$token = AFS::KTC_TOKEN-E<gt>nulltoken;>
Returns a NULL token. This token is only for use with the KAS methods
C<AuthServerConn> and C<SingleServerConn>. Do not use it with any other
methods or functions.
pod/v2/afsperlktct.pod view on Meta::CPAN
Undertakes all necessary steps for a complete authentication of
principal USER. It converts the string PASSWORD (the cleartext
password) for the principal USER to an encryption key. Then it creates
a TGT token. After that it asks for a service token for service I<AFS>
with a life time of LIFE (in seconds, given in 5 minute intervals).
Finally it saves the service token in the memory (kernel token cache).
Possible values for FLAGS are C<KA_USERAUTH_VERSION> and
C<KA_USERAUTH_DOSETPAG>. If PWEXP (default -1) is given it returns the
number of days till the password expires. On error the error message
is returned in REASON. It calls the AFS system library function
'ka_UserAuthenticateGeneral'.
=item B<$ok = AFS::KTC_TOKEN-E<gt>ForgetAllTokens;>
Discards all of the issuer's tokens. It calls the AFS system library
function 'ktc_ForgetAllTokens'.
=item B<$token = AFS::KTC_TOKEN-E<gt>FromString(STRING);>
# Items to export into callers namespace by default
# (move infrequently used names to @EXPORT_OK below)
@EXPORT = (@CELL, @MISC, @PTS, @CM, @ACL, @KA, @KTC);
# Other items we are prepared to export if requested
@EXPORT_OK = qw(
raise_exception
constant
convert_numeric_names
error_message
);
@ALL = (@EXPORT, @EXPORT_OK);
# convenience functions
#sub newacl { use AFS::ACL; AFS::ACL->new(@_); }
sub newacl { require AFS::ACL; AFS::ACL->import; AFS::ACL->new(@_); }
sub newpts { AFS::PTS->_new(@_); }
#define RV_CPINCR 0x020000
#define RV_NOVLDB 0x040000
#define RV_NOCLONE 0x080000
#define RV_NODEL 0x100000
#endif
#include <afs/vlserver.h>
#include <afs/volint.h>
#include <afs/cmd.h>
#include <afs/usd.h>
#include <afs/ptclient.h>
#include <afs/pterror.h>
#include <afs/print.h>
#include <afs/kauth.h>
#include <afs/kautils.h>
#include <afs/bosint.h>
#include <afs/bnode.h>
#include <afs/ktime.h>
#if defined(AFS_OLD_COM_ERR)
#include <com_err.h>
#else
#include <afs/com_err.h>
#define AFS_ABORT 1
#define AFS_FULL 2
#define AFS_INC 3
#ifdef AFS_PTHREAD_ENV
#undef clock_haveCurrentTime
#undef clock_UpdateTime
struct clock clock_now;
#endif /* AFS_PTHREAD_ENV*/
/* error handling macros */
#define ERROR_EXIT(code) {error=(code); goto error_exit;}
#define SETCODE(code) set_code(code)
#define BSETCODE(code, msg) bv_set_code(code, msg)
#define VSETCODE(code, msg) bv_set_code(code, msg)
#define KSETCODE(code, msg) k_set_code(code, msg)
#define PSETCODE(msg) p_set_code(msg)
static int32 raise_exception = 0;
void safe_hv_store (HV* ahv,char * key ,int i ,SV * asv,int j) {
if (! hv_store(ahv, key, i, asv, j)) {
fprintf(stderr,"Panic ... internal error. hv_store failed.\n");
exit(1);
}
return;
}
static void bv_set_code(code, msg)
int32 code;
const char *msg;
{
SV *sv = get_sv("AFS::CODE", TRUE);
int32 code = errno;
SV *sv = get_sv("AFS::CODE", TRUE);
sv_setiv(sv, (IV) code);
/* printf("P_SET_CODE %s (%d)\n", msg, code); */
if (code == 0) {
sv_setpv(sv, "");
}
else {
char buffer[1024];
if (raise_exception) {
sprintf(buffer, "AFS exception: %s (%s) (%d)", msg, error_message(code), code);
croak(buffer);
}
/* printf("P_SET_CODE %s (%d)\n", msg, code); */
sprintf(buffer, "%s: %s (%d)", msg, error_message(code), code);
sv_setpv(sv, buffer);
}
SvIOK_on(sv);
}
static void k_set_code(code, msg)
int32 code;
const char *msg;
{
SV *sv = get_sv("AFS::CODE", TRUE);
sv_setiv(sv, (IV) code);
/* printf("K_SET_CODE %s (%d)\n", msg, code); */
if (code == 0) {
sv_setpv(sv, "");
}
else {
char buffer[1024];
if (raise_exception) {
sprintf(buffer, "AFS exception: %s (%s) (%d)", msg, error_message(code), code);
croak(buffer);
}
/* printf("K_SET_CODE %s (%d)\n", msg, code); */
sprintf(buffer, "%s: %s (%d)", msg, error_message(code), code);
sv_setpv(sv, buffer);
}
SvIOK_on(sv);
}
static void set_code(code)
int32 code;
{
SV *sv = get_sv("AFS::CODE", TRUE);
if (code == -1) { code = errno; }
/* printf("SET_CODE %d\n", code); */
sv_setiv(sv, (IV) code);
if (code == 0) {
sv_setpv(sv, "");
}
else {
if (raise_exception) {
char buffer[1024];
sprintf(buffer, "AFS exception: %s (%d)", error_message(code), code);
croak(buffer);
}
sv_setpv(sv, (char *) error_message(code));
}
SvIOK_on(sv);
}
/* taken from openafs-1.2.9 */
/* volser/vsprocs.c */
int set_errbuff(buffer, errcode)
char *buffer;
int32 errcode;
{
case VOLSERDETACH_ERROR:
sprintf(buffer, "VOLSER: Could not detach the volume\n");
break;
case VOLSERILLEGAL_PARTITION:
sprintf(buffer, "VOLSER: encountered illegal partition number\n");
break;
case VOLSERBAD_ACCESS:
sprintf(buffer, "VOLSER: permission denied, not a super user\n");
break;
case VOLSERVLDB_ERROR:
sprintf(buffer, "VOLSER: error detected in the VLDB\n");
break;
case VOLSERBADNAME:
sprintf(buffer, "VOLSER: error in volume name\n");
break;
case VOLSERVOLMOVED:
sprintf(buffer, "VOLSER: volume has moved\n");
break;
case VOLSERBADOP:
sprintf(buffer, "VOLSER: illegal operation\n");
break;
case VOLSERBADRELEASE:
sprintf(buffer, "VOLSER: release could not be completed\n");
break;
if (acode == EACCES) {
fprintf(STDERR, "You are not authorized to perform the 'vos %s' command (%d)\n",
astring, acode);
}
else {
fprintf(STDERR, "Error in vos %s command.\n", astring);
PrintError("", acode);
}
return 0;
}
/* end of error handling macros */
/* general helper functions */
static struct afsconf_dir *cdir = NULL;
static char *config_dir = NULL;
static int32 internal_GetConfigDir()
{
if (cdir == NULL) {
}
/*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;
long blksize;
{
char *buffer = (char *) 0;
afs_int32 error = 0;
int done = 0;
afs_uint32 nbytes;
buffer = (char *) safemalloc(blksize);
if (!buffer) {
char buf[256];
sprintf(buf, "malloc failed\n");
VSETCODE(-1, buf);
return -1;
}
while (!error && !done) {
#ifndef AFS_NT40_ENV /* NT csn't select on non-socket fd's */
fd_set in;
FD_ZERO(&in);
FD_SET((long) (ufd->handle), &in);
/* don't timeout if read blocks */
#ifdef AFS_PTHREAD_ENV
select(((long) (ufd->handle)) + 1, &in, 0, 0, 0);
#else
IOMGR_Select(((long) (ufd->handle)) + 1, &in, 0, 0, 0);
#endif /* AFS_PTHREAD_ENV*/
#endif
error = USD_READ(ufd, buffer, blksize, &nbytes);
if (error) {
char buf[256];
sprintf(buf, "File system read failed\n");
VSETCODE(error, buf);
break;
}
if (nbytes == 0) {
done = 1;
break;
}
if (rx_Write(call, buffer, nbytes) != nbytes) {
error = -1;
break;
}
}
if (buffer)
free(buffer);
return error;
}
/* function invoked by UV_RestoreVolume, reads the data from rx_trx_stream and
* writes it out to the volume. */
afs_int32 WriteData(call, rock)
struct rx_call *call;
char *rock;
{
char *filename;
usd_handle_t ufd;
long blksize;
afs_int32 error, code;
int ufdIsOpen = 0;
error = 0;
filename = rock;
if (!filename || !*filename) {
usd_StandardInput(&ufd);
blksize = 4096;
ufdIsOpen = 1;
}
else {
code = usd_Open(filename, USD_OPEN_RDONLY, 0, &ufd);
if (code == 0) {
ufdIsOpen = 1;
code = USD_IOCTL(ufd, USD_IOCTL_GETBLKSIZE, &blksize);
}
if (code) {
char buffer[256];
sprintf(buffer, "Could not access file '%s'\n", filename);
error = VOLSERBADOP;
VSETCODE(error, buffer);
goto wfail;
}
}
code = SendFile(ufd, call, blksize);
if (code) {
error = code;
goto wfail;
}
wfail:
if (ufdIsOpen) {
code = USD_CLOSE(ufd);
if (code) {
char buffer[256];
sprintf(buffer, "Could not close dump file %s\n",
(filename && *filename) ? filename : "STDOUT");
VSETCODE(code, buffer);
if (!error)
error = code;
}
}
return error;
}
/* Receive data from <call> stream into file associated
* with <fd> <blksize>
*/
int ReceiveFile(ufd, call, blksize)
usd_handle_t ufd;
struct rx_call *call;
long blksize;
{
char *buffer = (char *) 0;
afs_int32 bytesread;
afs_uint32 bytesleft, w;
afs_int32 error = 0;
buffer = (char *) safemalloc(blksize);
if (!buffer) {
char buf[256];
sprintf(buf, "memory allocation failed\n");
VSETCODE(-1, buf);
ERROR_EXIT(-1);
}
while ((bytesread = rx_Read(call, buffer, blksize)) > 0) {
fd_set out;
FD_ZERO(&out);
FD_SET((long) (ufd->handle), &out);
/* don't timeout if write blocks */
#ifdef AFS_PTHREAD_ENV
select(((long) (ufd->handle)) + 1, 0, &out, 0, 0);
#else
IOMGR_Select(((long) (ufd->handle)) + 1, 0, &out, 0, 0);
#endif /* AFS_PTHREAD_ENV*/
#endif
error = USD_WRITE(ufd, &buffer[bytesread - bytesleft], bytesleft, &w);
if (error) {
char buf[256];
sprintf(buf, "File system write failed\n");
VSETCODE(-1, buf);
ERROR_EXIT(-1);
}
}
}
error_exit:
if (buffer)
free(buffer);
return (error);
}
afs_int32 DumpFunction(call, filename)
struct rx_call *call;
char *filename;
{
usd_handle_t ufd; /* default is to stdout */
afs_int32 error = 0, code;
afs_hyper_t size;
long blksize;
int ufdIsOpen = 0;
/* Open the output file */
if (!filename || !*filename) {
usd_StandardOutput(&ufd);
blksize = 4096;
ufdIsOpen = 1;
}
sprintf(buffer, "Could not create file '%s'\n", filename);
VSETCODE(VOLSERBADOP, buffer);
ERROR_EXIT(VOLSERBADOP);
}
}
code = ReceiveFile(ufd, call, blksize);
if (code)
ERROR_EXIT(code);
error_exit:
/* Close the output file */
if (ufdIsOpen) {
code = USD_CLOSE(ufd);
if (code) {
char buffer[256];
sprintf(buffer, "Could not close dump file %s\n",
(filename && *filename) ? filename : "STDIN");
VSETCODE(code, buffer);
if (!error)
error = code;
}
}
return (error);
}
struct tqElem {
afs_int32 volid;
struct tqElem *next;
};
struct tqHead {
afs_int32 count;
struct tqElem *next;
/* keep those lines small */
static char *em(acode)
afs_int32 acode;
{
if (acode == -1)
return "communications failure (-1)";
else if (acode == -3)
return "communications timeout (-3)";
else
return (char *) error_message(acode);
}
static struct rx_connection *internal_bos_new(code, hostname, localauth, noauth, aencrypt,
tname)
int32 *code;
char *hostname;
int localauth;
int noauth;
int aencrypt;
char *tname;
if (istatus.fileGoal)
sprintf(info, "%s", "temporarily disabled");
else
sprintf(info, "%s", "temporarily enabled");
}
safe_hv_store(stats, "info", 4, newSVpv(info, strlen(info)), 0);
safe_hv_store(stats, "goal", 4, newSViv(istatus.goal), 0);
safe_hv_store(stats, "fileGoal", 8, newSViv(istatus.fileGoal), 0);
if (istatus.flags & BOZO_ERRORSTOP) {
/* printf("stopped for too many errors, "); */
safe_hv_store(stats, "status", 6, newSViv(BOZO_ERRORSTOP), 0);
}
if (istatus.flags & BOZO_HASCORE) {
/* printf("has core file, "); */
safe_hv_store(stats, "status", 6, newSViv(BOZO_HASCORE), 0);
}
safe_hv_store(stats, "flags", 5, newSViv(istatus.flags), 0);
tp = buffer;
code = BOZO_GetStatus(aconn, aname, &temp, &tp);
/* 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;
/* printf(" Last error exit at %s, ", DateOf(istatus.lastErrorExit)); */
safe_hv_store(stats, "lastErrorExit", 13, newSViv(istatus.lastErrorExit), 0);
code = BOZO_GetInstanceStrings(aconn, aname, &is1, &is2, &is3, &is4);
/* don't complain about failing call, since could simply mean
* interface mismatch.
*/
if (code == 0) {
if (*is1 != 0) {
/* non-null instance string */
/* printf("by %s, ", is1); */
safe_hv_store(stats, "by", 2, newSVpv(is1, strlen(is1)), 0);
}
if (is1)
free(is1);
if (is2)
free(is2);
if (is3)
free(is3);
if (is4)
free(is4);
}
if (istatus.errorSignal) {
/* if (istatus.errorSignal == SIGTERM) */
/* printf("due to shutdown request\n"); */
/* else */
/* printf("due to signal %d\n", istatus.errorSignal); */
safe_hv_store(stats, "errorSignal", 11, newSViv(istatus.errorSignal), 0);
}
else {
/* printf("by exiting with code %d\n", istatus.errorCode); */
safe_hv_store(stats, "errorCode", 9, newSViv(istatus.errorCode), 0);
}
}
if (aint32p > 1) {
AV *av = (AV *) sv_2mortal((SV *) newAV());
/* try to display all the parms */
for (i = 0;; i++) {
tp = buffer;
code = BOZO_GetInstanceParm(aconn, aname, i, &tp);
partNumber = volutil_GetPartitionID(aparm1);
if (partNumber < 0) {
char buffer[256];
sprintf(buffer, "AFS::BOS: could not parse partition ID '%s'\n", aparm1);
BSETCODE(EINVAL, buffer);
return EINVAL;
}
tp = (char *) volutil_PartitionName(partNumber);
if (!tp) {
char buffer[256];
sprintf(buffer, "AFS::BOS: internal error parsing partition ID '%s'\n",
aparm1);
BSETCODE(EINVAL, buffer);
return EINVAL;
}
strcpy(partName, tp);
}
else
partName[0] = 0;
/* open the file name */
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);
if (code) {
SETCODE(code);
goto done;
}
}
if (time && strcmp(time, "0")) {
code = ktime_DateToInt32(time, &fromdate);
if (code) {
char buffer[256];
sprintf(buffer, "AFS::VOS: failed to parse date '%s' (error=%d))\n", time, code);
VSETCODE(code, buffer);
goto done;
}
}
if (file && (strlen(file) != 0)) {
strcpy(filename, file);
}
else {
strcpy(filename, "");
}
int32 apart=0, avolid;
int32 aserver=0, code, aserver1, apart1;
int32 vcode, iexclude=0, inoaction=0;
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)); */
MapHostToNetwork(vllist);
GetServerAndPart(vllist, RWVOL, &aserver1, &apart1, &previdx);
if (aserver1 == -1 || apart1 == -1) {
av_push(av2, newSVpv(vllist->name, strlen(vllist->name)));
fprintf(STDOUT, "could not backup %s, invalid VLDB entry\n", vllist->name);
totalFail++;
continue;
}
/* printf("vos-backupsys DEBUG-19\n"); */
if (aserver) {
same = VLDB_IsSameAddrs(aserver, aserver1, &error);
if (error) {
av_push(av2, newSVpv(vllist->name, strlen(vllist->name)));
fprintf(stderr,
"Failed to get info about server's %d address(es) from vlserver (err=%d); aborting call!\n",
aserver, error);
totalFail++;
continue;
}
}
/* printf("vos-backupsys DEBUG-20\n"); */
if ((aserver && !same) || (apart && (apart != apart1))) {
if (verbose) {
fprintf(STDOUT,
"Omitting to backup %s since the RW is in a different location\n",
vllist->name);
{
for (i = 0;; i++) {
tp = tbuffer;
code = BOZO_ListSUsers(self, i, &tp);
if (code)
break;
XPUSHs(sv_2mortal(newSVpv(tbuffer, strlen(tbuffer))));
}
if (code != 1) {
/* a real error code, instead of scanned past end */
char buffer[256];
sprintf(buffer, "AFS::BOS: failed to retrieve super-user list (%s)\n", em(code));
BSETCODE(code, buffer);
XSRETURN_UNDEF;
}
else {
SETCODE(0);
XSRETURN(i);
}
}
RETVAL
void
bos_getlog(self, file)
AFS::BOS self
char* file
PREINIT:
register struct rx_call *tcall;
int32 code = 0;
char buf, c[255];
int error, num = 0, i = 0;
PPCODE:
{
tcall = rx_NewCall(self);
code = StartBOZO_GetLog(tcall, file);
if (code) {
char buffer[256];
rx_EndCall(tcall, code);
sprintf(buffer, "AFS::BOS error %d (while reading log)\n", code);
BSETCODE(code, buffer);
XSRETURN_UNDEF;
}
/* copy data */
error = 0;
while (1) {
code = rx_Read(tcall, &buf, 1);
if (code != 1) {
error = EIO;
break;
}
if (buf == 0)
break; /* the end delimeter */
/* putchar(buf); */
c[i++] = buf;
if (buf == '\n') {
XPUSHs(sv_2mortal(newSVpv(c, i)));
i = 0;
num++;
}
}
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
} /* for loop */
if (everWorked) {
/* fprintf(stderr, "Keys last changed on %d.\n", keyInfo.mod_sec); */
EXTEND(sp, 2);
PUSHs(sv_2mortal(newSViv(keyInfo.mod_sec)));
PUSHs(newRV_inc((SV *) (list)));
}
if (code != BZDOM) {
char buffer[256];
sprintf(buffer, "AFS::BOS: %s error encountered while listing keys\n", em(code));
BSETCODE(code, buffer);
}
else {
code = 0;
}
if (everWorked) {
XSRETURN(2);
}
else {
KSETCODE(code, buffer);
safefree(t);
XSRETURN_UNDEF;
}
}
MODULE = AFS PACKAGE = AFS PREFIX = afs_
BOOT:
initialize_bz_error_table();
initialize_vols_error_table();
initialize_vl_error_table();
initialize_u_error_table();
initialize_pt_error_table();
initialize_ka_error_table();
initialize_acfg_error_table();
initialize_ktc_error_table();
initialize_rxk_error_table();
/* initialize_cmd_error_table(); */
/* initialize_budb_error_table(); */
/* initialize_butm_error_table(); */
/* initialize_butc_error_table(); */
void
afs__finalize()
CODE:
{
if (rx_initialized) {
rx_Finalize();
/* printf("AFS DEBUG rx_Finalize\n"); */
}
}
else {
safefree(t);
switch (code) {
case KABADREQUEST:
message = "password was incorrect";
break;
case KAUBIKCALL:
message = "Authentication Server was unavailable";
break;
default:
message = (char *) error_message(code);
}
sv_setpv(ST(4), message);
}
}
void
afs_ka_GetAuthToken(p,key,lifetime,pwexpires=-1)
AFS::KTC_PRINCIPAL p
PPCODE:
{
int32 code;
code = ktc_ForgetAllTokens();
SETCODE(code);
ST(0) = sv_2mortal(newSViv(code == 0));
XSRETURN(1);
}
void
afs_error_message(code)
int32 code
PPCODE:
{
ST(0) = sv_newmortal();
sv_setpv(ST(0), (char *) error_message(code));
XSRETURN(1);
}
/* this function is generated automatically by constant_gen */
/* You didn't think I would type in this crap did you? */
/* thats what perl is for :-) */
#if defined(AFS_3_4)
src/afs_prototypes.h view on Meta::CPAN
/*
* afs_prototypes.h for AFS Perl Extension module
*
* Prototypes for OpenAFS subroutines
* picked up from the OpenAFS header files
*/
#if defined(OpenAFS_1_0) || defined(OpenAFS_1_1) || defined(OpenAFS_1_2) || defined(OpenAFS_1_3)
extern const char *error_message();
#endif
extern int UV_SetSecurity(struct rx_securityClass *, afs_int32);
extern char *hostutil_GetNameByINet();
extern struct hostent *hostutil_GetHostByName(register char *ahost);
extern char *volutil_PartitionName();
extern int afsconf_ClientAuthSecure(struct afsconf_dir *,struct rx_securityClass **, int *);
extern int afsUUID_from_string(const char *str, afsUUID * uuid);
extern int afsUUID_to_string(const afsUUID * uuid, char *str, size_t strsz);
extern int des_read_pw_string(char *, int, char *, int);
extern int Lp_GetRwIndex(struct nvldbentry *);
src/com_err.h view on Meta::CPAN
/*
* Header file for common error description library.
*
* Copyright 1988, Student Information Processing Board of the
* Massachusetts Institute of Technology.
*
* For copyright and distribution info, see the documentation supplied
* with this package.
*/
#ifndef __AFS_COM_ERR_H
#include <stdarg.h>
extern void afs_com_err(const char *, afs_int32, const char *, ...);
extern void afs_com_err_va(const char *whoami, afs_int32 code, const char *fmt,
va_list args);
extern const char *afs_error_table_name(afs_int32);
extern const char *afs_error_message(afs_int32);
extern
void (*afs_set_com_err_hook
(void (*)(const char *, afs_int32, const char *, va_list)))
(const char *, afs_int32, const char *, va_list);
extern void (*afs_reset_com_err_hook(void)) (const char *, afs_int32,
const char *, va_list);
#define __AFS_COM_ERR_H
#ifdef AFS_OLD_COM_ERR
#define com_err afs_com_err
#define com_err_va afs_com_err_va
#define error_table_name afs_error_table_name
#define error_message afs_error_message
#define set_com_err_hook afs_set_com_err_hook
#define reset_com_err_hook afs_reset_com_err_hook
#endif /* AFS_OLD_COM_ERR */
#endif /* ! defined(__AFS_COM_ERR_H) */
src/inc/Test/Builder.pm view on Meta::CPAN
# Figure out if we passed or failed and print helpful messages.
if( @Test_Results ) {
# The plan? We have no plan.
if( $No_Plan ) {
$self->_print("1..$Curr_Test\n") unless $self->no_header;
$Expected_Tests = $Curr_Test;
}
# 5.8.0 threads bug. Shared arrays will not be auto-extended
# by a slice. Worse, we have to fill in every entry else
# we'll get an "Invalid value for shared scalar" error
for my $idx ($#Test_Results..$Expected_Tests-1) {
my %empty_result = ();
share(%empty_result);
$Test_Results[$idx] = \%empty_result
unless defined $Test_Results[$idx];
}
my $num_failed = grep !$_->{'ok'}, @Test_Results[0..$Expected_Tests-1];
$num_failed += abs($Expected_Tests - @Test_Results);
src/inc/Test/More.pm view on Meta::CPAN
local($@, $!); # eval sometimes resets $!
my $rslt = eval { $object->isa($class) };
if( $@ ) {
if( $@ =~ /^Can't call method "isa" on unblessed reference/ ) {
if( !UNIVERSAL::isa($object, $class) ) {
my $ref = ref $object;
$diag = "$obj_name isn't a '$class' it's a '$ref'";
}
} else {
die <<WHOA;
WHOA! I tried to call ->isa on your object and got some weird error.
This should never happen. Please contact the author immediately.
Here's the error.
$@
WHOA
}
}
elsif( !$rslt ) {
my $ref = ref $object;
$diag = "$obj_name isn't a '$class' it's a '$ref'";
}
}
src/inc/version/vpp.pm view on Meta::CPAN
my ($char) = shift->thischar();
return ($char =~ /[a-zA-Z]/);
}
sub isSPACE {
my ($char) = shift->thischar();
return ($char =~ /\s/);
}
sub BADVERSION {
my ($s, $errstr, $error) = @_;
if ($errstr) {
$$errstr = $error;
}
return $s;
}
sub prescan_version {
my ($s, $strict, $errstr, $sqv, $ssaw_decimal, $swidth, $salpha) = @_;
my $qv = defined $sqv ? $$sqv : FALSE;
my $saw_decimal = defined $ssaw_decimal ? $$ssaw_decimal : 0;
my $width = defined $swidth ? $$swidth : 3;
my $alpha = defined $salpha ? $$salpha : FALSE;
src/inc/version/vpp.pm view on Meta::CPAN
$s = new charstar $s;
while (isSPACE($s)) { # leading whitespace is OK
$s++;
}
$last = prescan_version($s, FALSE, \$errstr, \$qv, \$saw_decimal,
\$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++;
}
src/ppport.h view on Meta::CPAN
--version show version
--patch=file write one patch file with changes
--copy=suffix write changed copies with suffix
--diff=program use diff program and options
--compat-version=version provide compatibility with Perl version
--cplusplus accept C++ comments
--quiet don't output anything except fatal errors
--nodiag don't show diagnostics
--nohints don't show hints
--nochanges don't suggest changes
--nofilter don't filter input files
--strip strip all script and doc functionality from
ppport.h
--list-provided list provided API
--list-unsupported list unsupported API
src/ppport.h view on Meta::CPAN
=head2 --cplusplus
Usually, F<ppport.h> will detect C++ style comments and
replace them with C style comments for portability reasons.
Using this option instructs F<ppport.h> to leave C++
comments untouched.
=head2 --quiet
Be quiet. Don't print anything except fatal errors.
=head2 --nodiag
Don't output any diagnostic messages. Only portability
alerts will be printed.
=head2 --nohints
Don't output any hints. Hints often contain useful portability
notes. Warnings will still be displayed.
src/ppport.h view on Meta::CPAN
PL_copline|5.019002||p
PL_curcop|5.004050||p
PL_curpad||5.005000|
PL_curstash|5.004050||p
PL_debstash|5.004050||p
PL_defgv|5.004050||p
PL_diehook|5.004050||p
PL_dirty|5.004050||p
PL_dowarn|||pn
PL_errgv|5.004050||p
PL_error_count|5.019002||p
PL_expect|5.019002||p
PL_hexdigit|5.005000||p
PL_hints|5.005000||p
PL_in_my_stash|5.019002||p
PL_in_my|5.019002||p
PL_keyword_plugin||5.011002|
PL_last_in_gv|||n
PL_laststatval|5.005000||p
PL_lex_state|5.019002||p
PL_lex_stuff|5.019002||p
src/ppport.h view on Meta::CPAN
PadnamePV||5.019003|
PadnameSV||5.019003|
PadnameTYPE|||
PadnameUTF8||5.019003|
PadnamelistARRAY||5.019003|
PadnamelistMAX||5.019003|
PerlIO_clearerr||5.007003|
PerlIO_close||5.007003|
PerlIO_context_layers||5.009004|
PerlIO_eof||5.007003|
PerlIO_error||5.007003|
PerlIO_fileno||5.007003|
PerlIO_fill||5.007003|
PerlIO_flush||5.007003|
PerlIO_get_base||5.007003|
PerlIO_get_bufsiz||5.007003|
PerlIO_get_cnt||5.007003|
PerlIO_get_ptr||5.007003|
PerlIO_read||5.007003|
PerlIO_seek||5.007003|
PerlIO_set_cnt||5.007003|
src/ppport.h view on Meta::CPAN
ptr_table_new||5.009005|
ptr_table_split||5.009005|
ptr_table_store||5.009005|
push_scope|||
put_byte|||
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|
src/ppport.h view on Meta::CPAN
warner_nocontext|||vn
warner|5.006000|5.004000|pv
warn|||v
was_lvalue_sub|||
watch|||
whichsig_pvn||5.015004|
whichsig_pv||5.015004|
whichsig_sv||5.015004|
whichsig|||
win32_croak_not_implemented|||n
with_queued_errors|||
wrap_op_checker||5.015008|
write_to_stderr|||
xmldump_all_perl|||
xmldump_all|||
xmldump_attr|||
xmldump_eval|||
xmldump_form|||
xmldump_indent|||v
xmldump_packsubs_perl|||
xmldump_packsubs|||
xmldump_sub_perl|||
xmldump_sub|||
xmldump_vindent|||
xs_apiversion_bootcheck|||
xs_version_bootcheck|||
yyerror_pvn|||
yyerror_pv|||
yyerror|||
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};
src/ppport.h view on Meta::CPAN
}
my $s = $warnings != 1 ? 's' : '';
my $warn = $warnings ? " ($warnings warning$s)" : '';
info("Analysis completed$warn");
if ($file{changes}) {
if (exists $opt{copy}) {
my $newfile = "$filename$opt{copy}";
if (-e $newfile) {
error("'$newfile' already exists, refusing to write copy of '$filename'");
}
else {
local *F;
if (open F, ">$newfile") {
info("Writing copy of '$filename' with changes to '$newfile'");
print F $c;
close F;
}
else {
error("Cannot open '$newfile' for writing: $!");
}
}
}
elsif (exists $opt{patch} || $opt{changes}) {
if (exists $opt{patch}) {
unless ($patch_opened) {
if (open PATCH, ">$opt{patch}") {
$patch_opened = 1;
}
else {
error("Cannot open '$opt{patch}' for writing: $!");
delete $opt{patch};
$opt{changes} = 1;
goto fallback;
}
}
mydiff(\*PATCH, $filename, $c);
}
else {
fallback:
info("Suggested changes:");
src/ppport.h view on Meta::CPAN
if (!defined $diff) {
$diff = run_diff('diff -u', $file, $str);
}
if (!defined $diff) {
$diff = run_diff('diff', $file, $str);
}
if (!defined $diff) {
error("Cannot generate a diff. Please install Text::Diff or use --copy.");
return;
}
print F $diff;
}
sub run_diff
{
my($prog, $file, $str) = @_;
my $tmp = 'dppptemp';
src/ppport.h view on Meta::CPAN
$diff .= $_;
}
close F;
unlink $tmp;
return $diff;
}
unlink $tmp;
}
else {
error("Cannot open '$tmp' for writing: $!");
}
return undef;
}
sub rec_depend
{
my($func, $seen) = @_;
return () unless exists $depends{$func};
$seen = {%{$seen||{}}};
src/ppport.h view on Meta::CPAN
$opt{quiet} and return;
$opt{diag} and print @_, "\n";
}
sub warning
{
$opt{quiet} and return;
print "*** ", @_, "\n";
}
sub error
{
print "*** ERROR: ", @_, "\n";
}
my %given_hints;
my %given_warnings;
sub hint
{
$opt{quiet} and return;
my $func = shift;
src/ppport.h view on Meta::CPAN
# endif
#endif
#define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
#define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
/* It is very unlikely that anyone will try to use this with Perl 6
(or greater), but who knows.
*/
#if PERL_REVISION != 5
# error ppport.h only works with Perl version 5
#endif /* PERL_REVISION != 5 */
#ifndef dTHR
# define dTHR dNOOP
#endif
#ifndef dTHX
# define dTHX dNOOP
#endif
#ifndef dTHXa
# define dTHXa(x) dNOOP
src/ppport.h view on Meta::CPAN
# define PL_compiling compiling
# define PL_copline copline
# define PL_curcop curcop
# define PL_curstash curstash
# define PL_debstash debstash
# define PL_defgv defgv
# define PL_diehook diehook
# define PL_dirty dirty
# define PL_dowarn dowarn
# define PL_errgv errgv
# define PL_error_count error_count
# define PL_expect expect
# define PL_hexdigit hexdigit
# define PL_hints hints
# define PL_in_my in_my
# define PL_laststatval laststatval
# define PL_lex_state lex_state
# define PL_lex_stuff lex_stuff
# define PL_linestr linestr
# define PL_na na
# define PL_perl_destruct_level perl_destruct_level
src/ppport.h view on Meta::CPAN
# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
# define PL_linestr D_PPP_my_PL_parser_var(linestr)
# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
# define PL_bufend D_PPP_my_PL_parser_var(bufend)
# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
# define PL_in_my D_PPP_my_PL_parser_var(in_my)
# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
# define PL_error_count D_PPP_my_PL_parser_var(error_count)
#else
/* ensure that PL_parser != NULL and cannot be dereferenced */
# define PL_parser ((void *) 1)
#endif
#ifndef mPUSHs
# define mPUSHs(s) PUSHs(sv_2mortal(s))
src/ppport.h view on Meta::CPAN
# else
# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
(flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
# endif
#endif
/* Replace perl_eval_pv with eval_pv */
#ifndef eval_pv
#if defined(NEED_eval_pv)
static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
static
#else
extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
#endif
#ifdef eval_pv
# undef eval_pv
#endif
#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
#define Perl_eval_pv DPPP_(my_eval_pv)
#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
SV*
DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
{
dSP;
SV* sv = newSVpv(p, 0);
PUSHMARK(sp);
eval_sv(sv, G_SCALAR);
SvREFCNT_dec(sv);
SPAGAIN;
sv = POPs;
PUTBACK;
if (croak_on_error && SvTRUE(GvSV(errgv)))
croak(SvPVx(GvSV(errgv), na));
return sv;
}
#endif
#endif
#ifndef vload_module
#if defined(NEED_vload_module)
src/ppport.h view on Meta::CPAN
# define UVof "lo"
# define UVxf "lx"
# define UVXf "lX"
# elif IVSIZE == INTSIZE
# define IVdf "d"
# define UVuf "u"
# define UVof "o"
# define UVxf "x"
# define UVXf "X"
# else
# error "cannot define IV/UV formats"
# endif
#endif
#ifndef NVef
# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
/* Not very likely, but let's try anyway. */
# define NVef PERL_PRIeldbl
# define NVff PERL_PRIfldbl
# define NVgf PERL_PRIgldbl
src/t/AFS.t view on Meta::CPAN
# -*-cperl-*-
use strict;
use lib qw(../../inc ../inc ./inc);
use blib;
use Test::More tests => 10;
BEGIN {
use_ok('AFS', qw (
error_message constant
)
);
}
sub foo { return &AFS::KA_USERAUTH_DOSETPAG }
# test error_message
is(error_message(&AFS::PRNOMORE), 'may not create more groups', 'Return Code AFS::PRNOMORE');
is(error_message(180502), 'too many Ubik security objects outstanding', 'Return Code 180502');
# test subroutine returning a constant
is(foo(42,17), 65536, 'Sub Foo returns constant (2 args)');
is(foo(42), 65536, 'Sub Foo returns constant (1 arg)');
is(foo(), 65536, 'Sub Foo returns constant (no args)');
# test constant
is(constant('PRIDEXIST'), 267265, 'Constant PRIDEXIST');
is(constant('PRIDEXIST', 2), 267265, 'Constant PRIDEXIST with argument');
isnt(constant('zzz'), 267265, 'Unknown Constant zzz');
( run in 0.480 second using v1.01-cache-2.11-cpan-65fba6d93b7 )