Re: VMS::Persona
Peter Prymmer <[email protected]>
| Newsgroups | gmane.comp.lang.perl.ports.vms |
|---|---|
| Message-ID | <OF28070160.4255622F-ON852575FD.00737A24-852575FD.0074ABAD@factset.com> |
Peter Prymmer/FactSet wrote on 07/22/2009 12:30:14 PM: > I may be able to issue a patch to get the $VMS::Persona::VERSION == 1.01 > building against perl 5.8.7 on Alpha It could take me a bit of time though > (so do not hold your breathe). OK - you can start breathing again ;-) It sounds like Carl already has the s/na/PL_na/ stuff already taken care of. Nevertheless other folks on this list may still be interested in the content of this patch (see attachement). I note the following items regarding a successful run of mmk test (or mms test): 1. it must be run from a process with elevated privs to be successful 2. it must be run from an account other than SYSTEM (although now it is not necessary to have an ORACLE user to run this test, merely someone other than SYSTEM). This worked for us on Alpha, but we do not use it on our Itanium perl installations. I hope it proves helpful to you Carl and anyone else who might want to try it. Peter Prymmer
persona.patch
(application/octet-stream, 5.1 KB)
diff -ru cpan/vms/persona/persona.xs vms_patched/persona/persona.xs
--- cpan/vms/persona/persona.xs 1997-12-30 15:13:28.000000000 -0500
+++ vms_patched/persona/persona.xs 2009-07-24 16:55:13.000000000 -0400
@@ -1,3 +1,5 @@
+#define PERL_POLLUTE
+
#ifdef __cplusplus
extern "C" {
#endif
@@ -65,20 +67,20 @@
/* Run through the passed items */
for(i=0; i<items; i += 2) {
- if (strEQ("NAME", SvPV(ST(i), na))) {
- UserName = SvPV(ST(i + 1), na);
+ if (strEQ("NAME", SvPV(ST(i), PL_na))) {
+ UserName = SvPV(ST(i + 1), PL_na);
NameLen = strlen(UserName);
continue;
}
- if (strEQ("ASSUME_DEFPRIV", SvPV(ST(i), na))) {
+ if (strEQ("ASSUME_DEFPRIV", SvPV(ST(i), PL_na))) {
if (SvTRUE(ST(i+1))) {
PersonaFlags = PersonaFlags | IMP$M_ASSUME_DEFPRIV;
}
continue;
}
- if (strEQ("ASSUME_DEFCLASS", SvPV(ST(i), na))) {
+ if (strEQ("ASSUME_DEFCLASS", SvPV(ST(i), PL_na))) {
if (SvTRUE(ST(i+1))) {
PersonaFlags = PersonaFlags | IMP$M_ASSUME_DEFCLASS;
}
@@ -122,26 +124,26 @@
/* Run through the passed items */
for(i=0; i<items; i += 2) {
- if (strEQ("PERSONA", SvPV(ST(i), na))) {
+ if (strEQ("PERSONA", SvPV(ST(i), PL_na))) {
PersonaHandle = SvIV(ST(i + 1));
continue;
}
- if (strEQ("ASSUME_SECURITY", SvPV(ST(i), na))) {
+ if (strEQ("ASSUME_SECURITY", SvPV(ST(i), PL_na))) {
if (SvTRUE(ST(i+1))) {
PersonaFlags = PersonaFlags | IMP$M_ASSUME_SECURITY;
}
continue;
}
- if (strEQ("ASSUME_ACCOUNT", SvPV(ST(i), na))) {
+ if (strEQ("ASSUME_ACCOUNT", SvPV(ST(i), PL_na))) {
if (SvTRUE(ST(i+1))) {
PersonaFlags = PersonaFlags | IMP$M_ASSUME_ACCOUNT;
}
continue;
}
- if (strEQ("ASSUME_JOB_WIDE", SvPV(ST(i), na))) {
+ if (strEQ("ASSUME_JOB_WIDE", SvPV(ST(i), PL_na))) {
if (SvTRUE(ST(i+1))) {
PersonaFlags = PersonaFlags | IMP$M_ASSUME_JOB_WIDE;
}
diff -ru cpan/vms/persona/t/basic.t vms_patched/persona/t/basic.t
--- cpan/vms/persona/t/basic.t 1998-01-12 11:11:14.000000000 -0500
+++ vms_patched/persona/t/basic.t 2009-07-24 16:57:50.000000000 -0400
@@ -20,19 +20,19 @@
my ($PersonaOne, $PersonaTwo, $Username_One, $Username_Two);
-$Username_One = 'ORACLE';
+$Username_One = uc(getlogin()); # e.g. 'ORACLE';
$Username_Two = 'SYSTEM';
# Try creating the persona of the first user
$PersonaOne = VMS::Persona::new_persona(NAME => $Username_One);
-print defined($PersonaOne) ? "ok 2 # $PersonaOne\n" : "not ok 2\n";
+print defined($PersonaOne) ? "ok 2 # $PersonaOne\n" : "not ok 2 #$^E\n";
# Try deleting it
print VMS::Persona::delete_persona($PersonaOne) ? "ok 3\n" : "not ok 3 #$^E\n";
# Set our persona to the first user
$PersonaOne = VMS::Persona::new_persona(NAME => $Username_One);
-print VMS::Persona::assume_persona(PERSONA => $PersonaOne, ASSUME_JOB_WIDE => yes, ASSUME_ACCOUNT => yes, ASSUME_SECURITY => yes) ? "ok 4\n" : "not ok 4 #$^E\n";
+print VMS::Persona::assume_persona(PERSONA => $PersonaOne, ASSUME_JOB_WIDE => 'yes', ASSUME_ACCOUNT => 'yes', ASSUME_SECURITY => 'yes') ? "ok 4\n" : "not ok 4 #$^E\n";
# What does DCL think? get the name and trim trailing blanks
chomp($DCLUsername = `write sys\$output f\$getjpi("","USERNAME")`);
@@ -45,13 +45,16 @@
}
# Try deleting it while we're still using it. should fail
-print VMS::Persona::delete_persona($PersonaOne) ? "not ok 6\n" : "ok 6 #$^E\n";
+print VMS::Persona::delete_persona($PersonaOne) ? "not ok 6 #$^E\n" : "ok 6 #$^E\n";
# Try dropping it
print VMS::Persona::drop_persona() ? "ok 7\n" : "not ok 7 #$^E\n";
# Lets reassume it
-print VMS::Persona::assume_persona(PERSONA => $PersonaOne, ASSUME_JOB_WIDE => yes, ASSUME_ACCOUNT => yes, ASSUME_SECURITY => yes) ? "ok 8\n" : "not ok 8 #$^E\n";
+my $PersonaOne_again;
+$PersonaOne_again = VMS::Persona::new_persona(NAME => $Username_One);
+#print "# >$PersonaOne< >$PersonaOne_again<\n";
+print VMS::Persona::assume_persona(PERSONA => $PersonaOne_again, ASSUME_JOB_WIDE => 'yes', ASSUME_ACCOUNT => 'yes', ASSUME_SECURITY => 'yes') ? "ok 8\n" : "not ok 8 #$^E, $PersonaOne_again\n";
# Drop it again. Persona one might not have privs to create a new persona,
# so we'd best drop back to our base persona, which has to to get anywhere
@@ -60,10 +63,10 @@
# Try creating a second persona
$PersonaTwo = VMS::Persona::new_persona(NAME => $Username_Two);
-print defined($PersonaOne) ? "ok 9 # $PersonaTwo\n" : "not ok 9\n";
+print defined($PersonaTwo) ? "ok 9 # $PersonaOne,$PersonaTwo\n" : "not ok 9 #$^E\n";
# Assume the second persona
-print VMS::Persona::assume_persona(PERSONA => $PersonaTwo, ASSUME_JOB_WIDE => yes, ASSUME_ACCOUNT => yes, ASSUME_SECURITY => yes) ? "ok 10\n" : "not ok 10 #$^E\n";
+print VMS::Persona::assume_persona(PERSONA => $PersonaTwo, ASSUME_JOB_WIDE => 'yes', ASSUME_ACCOUNT => 'yes', ASSUME_SECURITY => 'yes') ? "ok 10\n" : "not ok 10 #$^E\n";
# What does DCL think? get the name and trim trailing blanks
chomp($DCLUsername = `write sys\$output f\$getjpi("","USERNAME")`);