Revision 9551
Added by Chris Jones almost 9 years ago
register-dataset.cgi | ||
---|---|---|
79 | 79 |
my $der_file_path = "/tmp/server.der"; |
80 | 80 |
|
81 | 81 |
# Signing certificate file name is based on the CN environment |
82 |
if ( $cnUrl && $tempDir ) {
|
|
82 |
if ( $cnUrl && $tempDir ) { |
|
83 | 83 |
my @parts = split(/\//, $cnUrl); |
84 | 84 |
$cn = $parts[2]; |
85 | 85 |
$pem_file_path = $tempDir . "/" . $cn . ".pem"; |
86 |
$der_file_path = $tempDir . "/" . $cn . ".der";
|
|
87 |
|
|
86 |
$der_file_path = $tempDir . "/" . $cn . ".der"; |
|
87 |
|
|
88 | 88 |
} |
89 | 89 |
|
90 | 90 |
# url configuration |
... | ... | |
264 | 264 |
} |
265 | 265 |
|
266 | 266 |
$template->process( $templates->{'login'}, $templateVars ); |
267 |
|
|
267 | 268 |
exit(); |
268 | 269 |
} |
269 | 270 |
elsif ( $FORM::stage =~ "logout" ) { |
... | ... | |
327 | 328 |
#debug("in modify stage"); |
328 | 329 |
# Modification of a file has been requested. |
329 | 330 |
# check if the user is logged in... |
330 |
my $session = CGI::Session->load() or die CGI::Session->errstr(); |
|
331 |
if ( $session->is_empty ) { |
|
331 |
if ( !validateSession() ) { |
|
332 | 332 |
|
333 | 333 |
# no session found ... redirect to login page template |
334 |
$$templateVars{'message'} = 'You must login to modify your dataset.';
|
|
334 |
$$templateVars{'message'} = 'Please login to modify your dataset.';
|
|
335 | 335 |
$template->process( $templates->{'login'}, $templateVars ); |
336 | 336 |
} |
337 | 337 |
else { |
... | ... | |
392 | 392 |
|
393 | 393 |
# no session found ... redirect to login page template |
394 | 394 |
$$templateVars{'showInstructions'} = 'true'; |
395 |
$$templateVars{'message'} = 'You must login to register your dataset.';
|
|
395 |
$$templateVars{'message'} = 'Please login to register your dataset.';
|
|
396 | 396 |
$template->process( $templates->{'login'}, $templateVars ); |
397 |
|
|
397 | 398 |
} |
398 | 399 |
else { |
399 | 400 |
|
... | ... | |
479 | 480 |
my ( $username, $password ) = getCredentials(); |
480 | 481 |
$response = $metacat->login( $username, $password ); |
481 | 482 |
my $errorMessage = ""; |
482 |
|
|
483 |
|
|
483 | 484 |
} |
484 |
|
|
485 |
|
|
485 | 486 |
# Parameters have been validated and Create the XML document |
486 | 487 |
my $xmldoc = createXMLDocument(); |
487 |
|
|
488 |
|
|
488 | 489 |
my $xmldocWithDocID = $xmldoc; |
489 | 490 |
my $errorMessage = ""; |
490 | 491 |
|
... | ... | |
526 | 527 |
|
527 | 528 |
# document is being inserted |
528 | 529 |
my $docStatus = "INCOMPLETE"; |
529 |
|
|
530 |
|
|
530 | 531 |
while ($docStatus eq "INCOMPLETE") { |
531 |
|
|
532 |
|
|
532 | 533 |
#Create the docid |
533 | 534 |
$docid = newDocid($scope, $metacat); |
534 |
|
|
535 |
|
|
535 | 536 |
$xmldocWithDocID =~ s/docid/$docid/; |
536 | 537 |
debugDoc($xmldocWithDocID); |
537 | 538 |
$docStatus = insertMetadata( $xmldocWithDocID, $docid ); |
538 |
|
|
539 |
|
|
539 | 540 |
} |
540 |
|
|
541 |
|
|
541 | 542 |
if ( $docStatus ne "SUCCESS" ) { |
542 | 543 |
debug("NO SUCCESS"); |
543 | 544 |
debug("Message is: $docStatus"); |
544 |
|
|
545 |
|
|
545 | 546 |
push( @errorMessages, $docStatus ); |
546 | 547 |
} |
547 | 548 |
else{ |
548 | 549 |
deleteRemovedData(); |
549 | 550 |
} |
550 |
|
|
551 |
|
|
551 | 552 |
} |
552 | 553 |
else { |
553 | 554 |
debug("The form has an existing docid: " . $FORM::docid); |
... | ... | |
678 | 679 |
modSendNotification( $title, $contactEmailAddress, $contactName, |
679 | 680 |
"Document $docid review pending" ); |
680 | 681 |
} |
681 |
|
|
682 |
|
|
682 | 683 |
} |
683 | 684 |
|
684 | 685 |
if ( scalar(@errorMessages) ) { |
... | ... | |
777 | 778 |
# checks metacat using newAccessionNumber |
778 | 779 |
################################################################################ |
779 | 780 |
sub newDocid { |
780 |
|
|
781 |
|
|
781 | 782 |
my $scope = shift; |
782 | 783 |
my $metacat = shift; |
783 | 784 |
my $scopeFound = 0; |
784 |
|
|
785 |
|
|
785 | 786 |
#Lock a local file while we are creating a new docid |
786 | 787 |
my $lockFilePath = "docids.lock"; |
787 | 788 |
open(LOCK, ">$lockFilePath"); |
788 | 789 |
flock(LOCK, LOCK_EX); |
789 |
|
|
790 |
|
|
790 | 791 |
my $lastdocid = newAccessionNumber($scope, $metacat); |
791 | 792 |
#Extract the docid number from the docid |
792 | 793 |
my @line = split(/\./, $lastdocid); |
793 | 794 |
my $num = $line[1]; |
794 |
|
|
795 |
|
|
795 | 796 |
my $docidsFilePath = $tempDir."/docids.txt"; |
796 | 797 |
my $docidsFilePathNew = $tempDir."/docids.txt.new"; |
797 |
|
|
798 |
|
|
798 | 799 |
#Open/create a local file while we are creating a new docid |
799 | 800 |
open my $docidsFile, '+<', $docidsFilePath; |
800 | 801 |
open my $docidsNewFile, '>', $docidsFilePathNew; |
801 |
|
|
802 |
|
|
802 | 803 |
#Read each docid scope,num in the file |
803 | 804 |
while( <$docidsFile> ) { |
804 | 805 |
my @line = split /,/; |
805 | 806 |
my $currentScope = $line[0]; |
806 |
|
|
807 |
|
|
807 | 808 |
if($currentScope eq $scope){ |
808 |
|
|
809 |
|
|
809 | 810 |
my $docidNum = $line[1] + 1; |
810 |
|
|
811 |
|
|
811 | 812 |
if($num > $docidNum){ |
812 | 813 |
$docid = "$scope.$num.1"; |
813 | 814 |
print $docidsNewFile "$scope,$num \n"; |
... | ... | |
823 | 824 |
print $docidsNewFile $_; |
824 | 825 |
} |
825 | 826 |
} |
826 |
|
|
827 |
|
|
827 | 828 |
#If this scope is not in the local docid store then add it |
828 | 829 |
if(!$scopeFound){ |
829 | 830 |
#Add to the local file |
830 | 831 |
print $docidsNewFile "$scope,$num \n"; |
831 | 832 |
} |
832 |
|
|
833 |
|
|
833 | 834 |
#Close the file and replace the old docids file with this new one |
834 | 835 |
close $docidsNewFile; |
835 | 836 |
close $docidsFile; |
836 | 837 |
move($docidsFilePathNew, $docidsFilePath); |
837 | 838 |
close LOCK; |
838 |
|
|
839 |
|
|
839 | 840 |
return $docid; |
840 | 841 |
} |
841 | 842 |
|
... | ... | |
870 | 871 |
unless hasContent($FORM::providerSurName); |
871 | 872 |
push( @invalidParams, "Dataset title is missing." ) |
872 | 873 |
unless hasContent($FORM::title); |
873 |
if ( $show->{'siteList'} eq 'true' ) {
|
|
874 |
if ( $show->{'siteList'} eq 'true' ) { |
|
874 | 875 |
push( @invalidParams, ucfirst( $config->{'site'} ) . " name is missing." ) |
875 | 876 |
unless ( ( hasContent($FORM::site) && !( $FORM::site =~ /^Select/ ) ) |
876 | 877 |
|| $skinName eq "nceas" ); |
... | ... | |
1274 | 1275 |
if ( $fileHash =~ /ondisk/ ) { |
1275 | 1276 |
( $docid, $fileHash ) = datafileInfo($fileHash); |
1276 | 1277 |
$outFile = $dataDir . "/" . $docid; |
1277 |
|
|
1278 |
|
|
1278 | 1279 |
} |
1279 | 1280 |
else { |
1280 | 1281 |
|
1281 | 1282 |
# normalize input filenames; Windows filenames include full paths |
1282 | 1283 |
$cleanName =~ s/.*[\/\\](.*)/$1/; |
1283 |
$outFile = $tempDir . "/" . $cleanName;
|
|
1284 |
$outFile = $tempDir . "/" . $cleanName; |
|
1284 | 1285 |
} |
1285 | 1286 |
debug("Reading file from disk: $outFile"); |
1286 |
|
|
1287 |
|
|
1287 | 1288 |
my $fileSize = stat($outFile)->size; |
1288 | 1289 |
if ( $fileSize == 0 ) { |
1289 | 1290 |
push( @errorMessages, "file $fileName is zero bytes!" ); |
1290 | 1291 |
debug("File $fileName is zero bytes!"); |
1291 | 1292 |
} |
1292 |
|
|
1293 |
|
|
1293 | 1294 |
# Now the file is on disk, send the object to Metacat |
1294 | 1295 |
if ( ! validateSession() ) { |
1295 | 1296 |
push( @errorMessages, "Must be logged in to upload files." ); |
... | ... | |
1300 | 1301 |
# remove the uniqueness of the filename |
1301 | 1302 |
# 'tempXXXXX' |
1302 | 1303 |
$cleanName = substr($cleanName, 9); |
1303 |
|
|
1304 |
|
|
1304 | 1305 |
if ( !$docid ) { |
1305 |
|
|
1306 |
|
|
1306 | 1307 |
my $uploadStatus = shift; |
1307 |
|
|
1308 |
|
|
1308 | 1309 |
while(!$uploadStatus){ |
1309 |
|
|
1310 |
|
|
1310 | 1311 |
$docid = newDocid($scope, $metacat); |
1311 |
|
|
1312 |
|
|
1312 | 1313 |
$uploadStatus = uploadData( $outFile, $docid, $cleanName ); |
1313 |
|
|
1314 |
|
|
1314 | 1315 |
if ( !$uploadStatus ) { |
1315 | 1316 |
debug("Uploading the data failed."); |
1316 | 1317 |
push( @errorMessages, "Data file $cleanName failed to upload"); |
... | ... | |
1325 | 1326 |
# TODO: should match the object promotion path, so that an |
1326 | 1327 |
# Excel upload results in 'dataTable' in this field |
1327 | 1328 |
my $entityType = 'Other'; |
1328 |
|
|
1329 |
|
|
1329 | 1330 |
my %dataInfo = ( |
1330 | 1331 |
'docid' => $docid, |
1331 | 1332 |
'entityid' => $entityid, |
... | ... | |
1405 | 1406 |
my $ctx = Digest::SHA1->new; |
1406 | 1407 |
$ctx->add($fileData); |
1407 | 1408 |
my $digest = $ctx->hexdigest; |
1408 |
|
|
1409 |
|
|
1409 | 1410 |
# use tempfile for writing |
1410 |
my $tmp = File::Temp->new(
|
|
1411 |
my $tmp = File::Temp->new( |
|
1411 | 1412 |
TEMPLATE => 'tempXXXXX', |
1412 | 1413 |
DIR => $tempDir, |
1413 |
SUFFIX => $cleanName,
|
|
1414 |
SUFFIX => $cleanName, |
|
1414 | 1415 |
UNLINK => 0); |
1415 | 1416 |
my $outputName = $tmp->filename(); |
1416 | 1417 |
#open( OUT, ">$outputName" ) or die "Could not open: $!"; |
1417 | 1418 |
print $tmp $fileData; |
1418 | 1419 |
close($tmp); |
1419 | 1420 |
debug("Writing output, result is: $outputName"); |
1420 |
|
|
1421 |
|
|
1421 | 1422 |
return ( $outputName, $digest ); |
1422 | 1423 |
} |
1423 | 1424 |
|
... | ... | |
1475 | 1476 |
my ($username, $password); |
1476 | 1477 |
my $metacat = Metacat->new($metacatUrl); |
1477 | 1478 |
setAuthToken($metacat); |
1478 |
|
|
1479 |
|
|
1479 | 1480 |
my $response = hasValidAuthToken(); |
1480 | 1481 |
if ( ! $response ) { |
1481 | 1482 |
( $username, $password ) = getCredentials(); |
1482 | 1483 |
$response = $metacat->login( $username, $password ); |
1483 |
|
|
1484 |
|
|
1484 | 1485 |
} |
1485 | 1486 |
if ( !$response ) { |
1486 | 1487 |
my $msg = $metacat->getMessage(); |
... | ... | |
1511 | 1512 |
my $filename = shift; |
1512 | 1513 |
|
1513 | 1514 |
debug("Upload -- Starting upload of $docid"); |
1514 |
|
|
1515 |
|
|
1515 | 1516 |
my $response = $metacat->upload( $docid, $data, $filename ); |
1516 | 1517 |
if ( !$response ) { |
1517 |
|
|
1518 |
|
|
1518 | 1519 |
my $uploadMsg = $metacat->getMessage(); |
1519 |
|
|
1520 |
|
|
1520 | 1521 |
push( @errorMessages, |
1521 | 1522 |
"Failed to upload file. Error was: $uploadMsg\n" ); |
1522 |
|
|
1523 |
|
|
1523 | 1524 |
debug("Upload -- Error is: $uploadMsg"); |
1524 | 1525 |
} |
1525 | 1526 |
else { |
1526 | 1527 |
debug("Upload -- Success! New docid $docid"); |
1527 | 1528 |
} |
1528 |
|
|
1529 |
|
|
1529 | 1530 |
return $response; |
1530 | 1531 |
} |
1531 | 1532 |
|
... | ... | |
1538 | 1539 |
sub createXMLDocument { |
1539 | 1540 |
if ( $debug_enabled ) { |
1540 | 1541 |
debug("createXMLDocument() called."); |
1541 |
|
|
1542 |
|
|
1542 | 1543 |
} |
1543 |
|
|
1544 | 1544 |
|
1545 |
|
|
1545 | 1546 |
#FIXME placeholder for $FORM element, should be determined by config |
1546 | 1547 |
|
1547 | 1548 |
if ( $skinName eq "ebm" ) { |
... | ... | |
1582 | 1583 |
} |
1583 | 1584 |
|
1584 | 1585 |
sub createDatasetDocument { |
1585 |
|
|
1586 |
|
|
1586 | 1587 |
if ( $debug_enabled ) { |
1587 | 1588 |
debug("createDatasetDocument() called."); |
1588 |
|
|
1589 |
|
|
1589 | 1590 |
} |
1590 |
|
|
1591 |
|
|
1591 | 1592 |
my $doc = EMLStart(); |
1592 | 1593 |
$doc .= accessElement(); |
1593 | 1594 |
$doc .= datasetStart(); |
... | ... | |
1676 | 1677 |
$elem .= "</individualName>\n"; |
1677 | 1678 |
|
1678 | 1679 |
if ( ( $role eq 'personnel' ) && ($FORM::origNameOrgContact) ) { |
1679 |
$elem .= |
|
1680 |
"<organizationName>$FORM::origNameOrgContact</organizationName>\n"; |
|
1680 |
$elem .= "<organizationName>$FORM::origNameOrgContact</organizationName>\n"; |
|
1681 | 1681 |
} |
1682 | 1682 |
|
1683 | 1683 |
if ( ( $role eq 'personnel' ) || ( $role eq 'associatedParty' ) ) { |
... | ... | |
1687 | 1687 |
} |
1688 | 1688 |
$elem .= "<role>" . normalize($roleElem) . "</role>\n"; |
1689 | 1689 |
} |
1690 |
$elemList .= "<$role>$elem</$role>\n"; |
|
1690 |
# Ensure the metadataProvider is added before additionalParty |
|
1691 |
my $fullElement = "<$role>$elem</$role>\n"; |
|
1692 |
if ( $role eq "metadataProvider" ) { |
|
1693 |
$fullElement .= $elemList; |
|
1694 |
$elemList = $fullElement; |
|
1695 |
|
|
1696 |
} else { |
|
1697 |
$elemList .= $fullElement; |
|
1698 |
|
|
1699 |
} |
|
1691 | 1700 |
} |
1692 | 1701 |
} |
1693 | 1702 |
return $elemList; |
... | ... | |
1746 | 1755 |
$accessList = qq| |
1747 | 1756 |
<access authSystem="knb" order="allowFirst"> |
1748 | 1757 |
$skinAccess |
1749 |
$userAccess
|
|
1758 |
$userAccess |
|
1750 | 1759 |
<$defaultAccess> |
1751 | 1760 |
<principal>public</principal> |
1752 | 1761 |
<permission>read</permission> |
... | ... | |
2404 | 2413 |
} |
2405 | 2414 |
|
2406 | 2415 |
sub accessElement { |
2407 |
|
|
2416 |
|
|
2408 | 2417 |
if ( $debug_enabled ) { |
2409 | 2418 |
debug('accessElement() called.'); |
2410 | 2419 |
} |
2411 |
|
|
2420 |
|
|
2412 | 2421 |
my $public = shift; |
2413 | 2422 |
if ( !$public ) { |
2414 | 2423 |
$public = $config->{'publicReadable'}; |
... | ... | |
2450 | 2459 |
} |
2451 | 2460 |
|
2452 | 2461 |
sub getUsername() { |
2453 |
|
|
2462 |
|
|
2454 | 2463 |
if ( $debug_enabled ) { |
2455 | 2464 |
debug('getUsername() called.'); |
2456 |
|
|
2465 |
|
|
2457 | 2466 |
} |
2458 |
|
|
2467 |
|
|
2459 | 2468 |
my $username = ''; |
2460 | 2469 |
my $authBase = $properties->getProperty("auth.base"); |
2461 | 2470 |
|
2462 | 2471 |
# Support authentication token usernames |
2463 | 2472 |
my $token_info = getTokenInfo(); |
2464 |
|
|
2473 |
|
|
2465 | 2474 |
if ( $token_info->{'isValid'} ) { |
2466 | 2475 |
$username = $token_info->{'sub'}; |
2467 | 2476 |
debug("Username: $username"); |
2468 | 2477 |
return $token_info->{'sub'}; |
2469 |
|
|
2478 |
|
|
2470 | 2479 |
} |
2471 |
|
|
2480 |
|
|
2472 | 2481 |
# Support CGI session usernames |
2473 | 2482 |
if ( $FORM::username ne '' ) { |
2474 | 2483 |
$username = |
... | ... | |
2508 | 2517 |
if ( ! hasValidAuthToken() ) { |
2509 | 2518 |
my ( $username, $password ) = getCredentials(); |
2510 | 2519 |
$metacat->login( $username, $password ); |
2511 |
|
|
2520 |
|
|
2512 | 2521 |
} |
2513 | 2522 |
|
2514 | 2523 |
$httpMessage = $metacat->read($docid); |
... | ... | |
3367 | 3376 |
push( @admins, $adminUsername ); |
3368 | 3377 |
|
3369 | 3378 |
#debug("getting user groups for current user"); |
3370 |
|
|
3379 |
|
|
3371 | 3380 |
my @userGroups = getUserGroups(); |
3372 | 3381 |
|
3373 | 3382 |
foreach $node ( $results->get_nodelist ) { |
... | ... | |
3383 | 3392 |
$permission = $child->textContent(); |
3384 | 3393 |
} |
3385 | 3394 |
} |
3386 |
|
|
3395 |
|
|
3387 | 3396 |
if (($principal eq 'public') && ($permission ne 'read')) { |
3388 | 3397 |
# If the principal is 'public' and the permission is not 'read' then this document |
3389 |
# could not have been created in the registry.
|
|
3398 |
# could not have been created in the registry. |
|
3390 | 3399 |
$errorMessage = "The ACL for this document has been changed outside the registry. Please use Morpho to edit this document (Access Error: public principal cannot have $permission permission).\n"; |
3391 | 3400 |
$accessError = 1; |
3392 | 3401 |
debug($errorMessage); |
3393 |
}
|
|
3402 |
} |
|
3394 | 3403 |
if (($principal eq $adminUsername) && ($permission ne 'all')) { |
3395 | 3404 |
# If the principal is the admin and permission is not 'all' then this document |
3396 |
# could not have been created in the registry.
|
|
3405 |
# could not have been created in the registry. |
|
3397 | 3406 |
$errorMessage = "The ACL for this document has been changed outside the registry. Please use Morpho to edit this document (Access Error: admin principal cannot have $permission permission).\n"; |
3398 | 3407 |
$accessError = 1; |
3399 | 3408 |
debug($errorMessage); |
3400 |
}
|
|
3409 |
} |
|
3401 | 3410 |
|
3402 |
# no access error in doc, if principal is not equal to public and permission is
|
|
3411 |
# no access error in doc, if principal is not equal to public and permission is |
|
3403 | 3412 |
# 'all' (requirements in registry) then try and determine if user has access |
3404 | 3413 |
if (!$accessError && ($principal ne 'public') && ($permission eq 'all' || $permission eq 'write')) { |
3405 | 3414 |
my ($username, $password) = getCredentials(); |
3406 |
|
|
3415 |
|
|
3407 | 3416 |
# 1) check if user matches principal |
3408 | 3417 |
#debug("does user $username match principal $principal?"); |
3409 | 3418 |
if ($principal eq $username) { |
3410 |
$accessGranted = 1;
|
|
3419 |
$accessGranted = 1; |
|
3411 | 3420 |
#debug("Access granted: user $username matches principal"); |
3412 | 3421 |
} |
3413 |
|
|
3414 |
# 2) if access not granted, check if user group matches principal
|
|
3422 |
|
|
3423 |
# 2) if access not granted, check if user group matches principal |
|
3415 | 3424 |
if (!$accessGranted) { |
3416 | 3425 |
#debug("is one of the user groups @userGroups the principal $principal?"); |
3417 | 3426 |
for my $userGroup (@userGroups) { |
... | ... | |
3421 | 3430 |
last; |
3422 | 3431 |
} |
3423 | 3432 |
} |
3424 |
}
|
|
3425 |
}
|
|
3426 |
|
|
3433 |
} |
|
3434 |
} |
|
3435 |
|
|
3427 | 3436 |
# if there was an access error, we know this is not a valid registry doc. No need to |
3428 | 3437 |
# continue looking at access sections in doc. Same it true if we were granted access |
3429 | 3438 |
# already. |
... | ... | |
3431 | 3440 |
last; |
3432 | 3441 |
} |
3433 | 3442 |
} |
3434 |
|
|
3435 |
if (!$accessError) {
|
|
3443 |
|
|
3444 |
if (!$accessError) { |
|
3436 | 3445 |
my ($username, $password) = getCredentials(); |
3437 |
|
|
3446 |
|
|
3438 | 3447 |
# 3) if access not granted, check if the user is a moderator or admin |
3439 | 3448 |
if (!$accessGranted) { |
3440 | 3449 |
#debug("is user $username in admins @admins?"); |
... | ... | |
3443 | 3452 |
#debug("Access granted: user $username is an admin or moderator"); |
3444 | 3453 |
} |
3445 | 3454 |
} |
3446 |
|
|
3455 |
|
|
3447 | 3456 |
# 4) if access not granted, check if user group in moderator/admin list |
3448 | 3457 |
if (!$accessGranted) { |
3449 | 3458 |
#debug("is one of the user groups @userGroups in admins @admins?"); |
... | ... | |
3454 | 3463 |
last; |
3455 | 3464 |
} |
3456 | 3465 |
} |
3457 |
}
|
|
3458 |
|
|
3459 |
# 5) if access not granted, and there was no other error, the user is not authorized.
|
|
3466 |
} |
|
3467 |
|
|
3468 |
# 5) if access not granted, and there was no other error, the user is not authorized. |
|
3460 | 3469 |
# Set accessError to true and set the error string |
3461 | 3470 |
if (!$accessError && !$accessGranted) { |
3462 | 3471 |
$errorMessage = "User $username is not authorized to access document\n"; |
... | ... | |
3558 | 3567 |
|
3559 | 3568 |
# Login to metacat |
3560 | 3569 |
my $errorMessage = ""; |
3561 |
|
|
3570 |
|
|
3562 | 3571 |
my $response = hasValidAuthToken(); |
3563 | 3572 |
if ( ! $response ) { |
3564 | 3573 |
my ( $username, $password ) = getCredentials(); |
3565 | 3574 |
$response = $metacat->login( $username, $password ); |
3566 |
|
|
3575 |
|
|
3567 | 3576 |
} |
3568 | 3577 |
|
3569 | 3578 |
if ( !$response ) { |
... | ... | |
3687 | 3696 |
my $password = $FORM::password; |
3688 | 3697 |
|
3689 | 3698 |
my $metacat = Metacat->new($metacatUrl); |
3690 |
|
|
3699 |
|
|
3691 | 3700 |
my $returnVal = $metacat->login( $username, $password ); |
3692 |
|
|
3693 |
debug("Login was $returnVal for login " .
|
|
3701 |
|
|
3702 |
debug("Login was $returnVal for login " . |
|
3694 | 3703 |
"attempt to $metacatUrl, with $username"); |
3695 |
|
|
3704 |
|
|
3696 | 3705 |
if ( $returnVal > 0 ) { |
3697 | 3706 |
|
3698 | 3707 |
# valid username and passwd |
... | ... | |
3777 | 3786 |
$uname = $session->param("username"); |
3778 | 3787 |
$session->delete(); |
3779 | 3788 |
} |
3780 |
|
|
3789 |
|
|
3781 | 3790 |
# send redirect form to metacat and action = logout |
3782 | 3791 |
my $html = "<html><head>"; |
3783 | 3792 |
$html .= "</head><body onload=\"document.loginForm.submit()\">"; |
3784 | 3793 |
$html .= "<form name=\"loginForm\" method=\"post\" action=\"" |
3785 | 3794 |
. $metacatUrl . "\">"; |
3786 | 3795 |
$html .= "<input type=\"hidden\" name=\"action\" value=\"logout\" />"; |
3787 |
$html .= "<input type=\"hidden\" name=\"username\" value=\""
|
|
3796 |
$html .= "<input type=\"hidden\" name=\"username\" value=\"" |
|
3788 | 3797 |
. $uname . "\" />"; |
3789 | 3798 |
$html .= "<input type=\"hidden\" name=\"qformat\" value=\"" |
3790 | 3799 |
. $skinName . "\" />"; |
... | ... | |
3798 | 3807 |
# |
3799 | 3808 |
################################################################################ |
3800 | 3809 |
sub getCredentials { |
3801 |
|
|
3810 |
|
|
3802 | 3811 |
my $userDN = $FORM::username; |
3803 | 3812 |
my $userOrg = $FORM::organization; |
3804 | 3813 |
my $userPass = $FORM::password; |
3805 | 3814 |
my $authBase = $properties->getProperty("auth.base"); |
3806 | 3815 |
my $dname = "uid=$userDN,o=$userOrg,$authBase"; |
3807 | 3816 |
my $token_info; |
3808 |
|
|
3817 |
|
|
3809 | 3818 |
if ( hasValidAuthToken() ) { |
3810 | 3819 |
$token_info = getTokenInfo(); |
3811 | 3820 |
$dname = $token_info->{'sub'}; |
3812 |
|
|
3821 |
|
|
3813 | 3822 |
} else { |
3814 | 3823 |
my $session = CGI::Session->load(); |
3815 | 3824 |
if ( !( $session->is_empty || $session->is_expired ) ) { |
3816 | 3825 |
$dname = $session->param("username"); |
3817 | 3826 |
$userPass = $session->param("password"); |
3818 | 3827 |
} |
3819 |
|
|
3828 |
|
|
3829 |
|
|
3820 | 3830 |
} |
3821 | 3831 |
|
3822 | 3832 |
return ( $dname, $userPass ); |
... | ... | |
3829 | 3839 |
################################################################################ |
3830 | 3840 |
sub getUserGroups { |
3831 | 3841 |
my $sessionId = shift; |
3832 |
|
|
3842 |
|
|
3833 | 3843 |
#debug("getting user info for session id: $sessionId"); |
3834 | 3844 |
my $metacat = Metacat->new($metacatUrl); |
3835 | 3845 |
setAuthToken($metacat); |
3836 |
|
|
3846 |
|
|
3837 | 3847 |
if ( ! hasValidAuthToken() ) { |
3838 | 3848 |
my ( $username, $password ) = getCredentials(); |
3839 | 3849 |
$metacat->login( $username, $password ); |
3840 |
|
|
3850 |
|
|
3841 | 3851 |
} |
3842 |
|
|
3852 |
|
|
3843 | 3853 |
my $userInfo = $metacat->getUserInfo($sessionId); |
3844 |
|
|
3854 |
|
|
3845 | 3855 |
debug("user info xml: $userInfo"); |
3846 |
|
|
3856 |
|
|
3847 | 3857 |
my $parser = XML::LibXML->new(); |
3848 | 3858 |
my $parsedDoc = $parser->parse_string($userInfo); |
3849 |
|
|
3859 |
|
|
3850 | 3860 |
my $groupString = $parsedDoc->findvalue('//user/groupNames'); |
3851 |
|
|
3861 |
|
|
3852 | 3862 |
my @groupArray; |
3853 | 3863 |
foreach (split(":", $groupString)) { |
3854 | 3864 |
$_ =~ s/^\s+//; |
... | ... | |
3954 | 3964 |
if ( ! hasValidAuthToken() ) { |
3955 | 3965 |
my ( $username, $password ) = getCredentials(); |
3956 | 3966 |
$metacat->login( $username, $password ); |
3957 |
|
|
3967 |
|
|
3958 | 3968 |
} |
3959 |
|
|
3969 |
|
|
3960 | 3970 |
my $parser = XML::LibXML->new(); |
3961 | 3971 |
my $docid = $FORM::docid; |
3962 | 3972 |
my ( $x, $y, $z ) = split( /\./, $docid ); |
... | ... | |
4022 | 4032 |
my $response = hasValidAuthToken(); |
4023 | 4033 |
if ( ! $response ) { |
4024 | 4034 |
$response = $metacat->login( $modUsername, $modPassword ); |
4025 |
|
|
4035 |
|
|
4026 | 4036 |
} |
4027 | 4037 |
my $docid = $FORM::docid; |
4028 | 4038 |
|
... | ... | |
4200 | 4210 |
my $response = hasValidAuthToken(); |
4201 | 4211 |
if ( ! $response ) { |
4202 | 4212 |
$response = $metacat->login( $modUsername, $modPassword ); |
4203 |
|
|
4213 |
|
|
4204 | 4214 |
} |
4205 | 4215 |
|
4206 | 4216 |
if ( !$response ) { |
... | ... | |
4343 | 4353 |
my $response = hasValidAuthToken(); |
4344 | 4354 |
if ( ! $response ) { |
4345 | 4355 |
$response = $metacat->login( $modUsername, $modPassword ); |
4346 |
|
|
4356 |
|
|
4347 | 4357 |
} |
4348 | 4358 |
|
4349 | 4359 |
if ( !$response ) { |
... | ... | |
5048 | 5058 |
if ( !$error ) { |
5049 | 5059 |
# If no errors, then print out data in confirm Data template |
5050 | 5060 |
$$templateVars{'section'} = "Confirm Data"; |
5051 |
|
|
5061 |
|
|
5052 | 5062 |
#Just return the data file upload details, if specified |
5053 | 5063 |
if(param("justGetUploadDetails")){ |
5054 |
$template->process( $templates->{'dataUploadDetails'}, $templateVars );
|
|
5064 |
$template->process( $templates->{'dataUploadDetails'}, $templateVars ); |
|
5055 | 5065 |
} |
5056 | 5066 |
else{ |
5057 | 5067 |
$template->process( $templates->{'confirmData'}, $templateVars ); |
... | ... | |
5542 | 5552 |
|
5543 | 5553 |
################################################################################ |
5544 | 5554 |
# |
5545 |
# Set the incoming HTTP Authorization header as an instance variable in the
|
|
5555 |
# Set the incoming HTTP Authorization header as an instance variable in the |
|
5546 | 5556 |
# given Metacat object |
5547 | 5557 |
# |
5548 | 5558 |
################################################################################ |
5549 | 5559 |
sub setAuthToken() { |
5550 | 5560 |
my $metacat = shift; |
5551 |
|
|
5561 |
|
|
5552 | 5562 |
if ( $debug_enabled ) { |
5553 | 5563 |
debug('setAuthToken() called.'); |
5554 |
|
|
5564 |
|
|
5555 | 5565 |
} |
5556 |
|
|
5566 |
|
|
5557 | 5567 |
eval { $metacat->isa('Metacat'); }; |
5558 |
|
|
5568 |
|
|
5559 | 5569 |
if ( ! $@ ) { |
5560 | 5570 |
# Set the auth_token_header if available |
5561 | 5571 |
if ( $ENV{'HTTP_AUTHORIZATION'}) { |
5562 |
$metacat->set_options(
|
|
5572 |
$metacat->set_options( |
|
5563 | 5573 |
auth_token_header => $ENV{'HTTP_AUTHORIZATION'}); |
5564 | 5574 |
} else { |
5565 | 5575 |
if ( $debug_enabled ) { |
5566 | 5576 |
debug("There is no HTTP_AUTHORIZATION variable. " . |
5567 | 5577 |
"Did not set Metacat->{'auth_token_header'}"); |
5568 |
|
|
5578 |
|
|
5569 | 5579 |
} |
5570 | 5580 |
} |
5571 |
|
|
5581 |
|
|
5572 | 5582 |
} else { |
5573 | 5583 |
debug('Not an instance of Metacat.' . |
5574 | 5584 |
'Pass a Metacat object only to setAuthToken().'); |
... | ... | |
5582 | 5592 |
# |
5583 | 5593 |
################################################################################ |
5584 | 5594 |
sub getSigningCertificate() { |
5585 |
|
|
5595 |
|
|
5586 | 5596 |
if ( $debug_enabled ) { |
5587 | 5597 |
debug('getSigningCertificate called.'); |
5588 |
|
|
5589 |
}
|
|
5590 |
|
|
5598 |
|
|
5599 |
} |
|
5600 |
|
|
5591 | 5601 |
open(my $pem_cert_file, ">", $pem_file_path) |
5592 | 5602 |
or die "\nCould not open PEM certificate file: $!\n"; |
5593 | 5603 |
|
5594 | 5604 |
# Attempts to use IO::Socket::SSL->peer_certificate() |
5595 |
# and Net::SSLeay->get_peer_certificate()
|
|
5596 |
# return an unparseable cert (it seems).
|
|
5605 |
# and Net::SSLeay->get_peer_certificate() |
|
5606 |
# return an unparseable cert (it seems). |
|
5597 | 5607 |
# Settle for the openssl command instead. |
5598 | 5608 |
# my $client = IO::Socket::SSL->new('cn-stage.test.dataone.org:443') |
5599 | 5609 |
# or die "error=$!, ssl_error=$SSL_ERROR"; |
... | ... | |
5612 | 5622 |
if ( $line =~ /BEGIN/) { |
5613 | 5623 |
$start_line_number = $count; |
5614 | 5624 |
last; |
5615 |
|
|
5616 |
}
|
|
5625 |
|
|
5626 |
} |
|
5617 | 5627 |
} |
5618 | 5628 |
|
5619 | 5629 |
# Find the end line of the first cert |
... | ... | |
5623 | 5633 |
if ( $line =~ /END/) { |
5624 | 5634 |
$end_line_number = $count; |
5625 | 5635 |
last; |
5626 |
|
|
5627 |
}
|
|
5636 |
|
|
5637 |
} |
|
5628 | 5638 |
} |
5629 | 5639 |
|
5630 | 5640 |
# print the cert to a PEM file |
... | ... | |
5633 | 5643 |
$count = $count + 1; |
5634 | 5644 |
if ( $count >= $start_line_number && $count <= $end_line_number) { |
5635 | 5645 |
print $pem_cert_file $line; |
5636 |
|
|
5637 |
}
|
|
5646 |
|
|
5647 |
} |
|
5638 | 5648 |
} |
5639 | 5649 |
|
5640 | 5650 |
close($pem_cert_file); |
5641 | 5651 |
|
5642 | 5652 |
# Convert the PEM to DER |
5643 |
my @convert_der_args = ("openssl", "x509",
|
|
5653 |
my @convert_der_args = ("openssl", "x509", |
|
5644 | 5654 |
"-in", $pem_file_path, "-inform", "PEM", |
5645 | 5655 |
"-out", $der_file_path, "-outform", "DER"); |
5646 | 5656 |
system(@convert_der_args); |
5647 |
|
|
5657 |
|
|
5648 | 5658 |
# For debugging, display the cert details |
5649 | 5659 |
if ( $debug_enabled ) { |
5650 | 5660 |
my @cert_info = `openssl x509 -noout -issuer -subject -dates -in $pem_file_path`; |
5651 | 5661 |
debug("Signing certificate info: "); |
5652 | 5662 |
for my $info_line (@cert_info) { |
5653 | 5663 |
debug($info_line); |
5654 |
|
|
5664 |
|
|
5655 | 5665 |
} |
5656 | 5666 |
} |
5657 | 5667 |
} |
... | ... | |
5666 | 5676 |
if ( $debug_enabled ) { |
5667 | 5677 |
debug('getTokenInfo() called.'); |
5668 | 5678 |
} |
5669 |
|
|
5679 |
|
|
5670 | 5680 |
my $token_info = { |
5671 | 5681 |
userId => '', |
5672 | 5682 |
issuedAt => '', |
... | ... | |
5679 | 5689 |
isValid => 0 |
5680 | 5690 |
}; |
5681 | 5691 |
|
5682 |
my $token = ""; |
|
5683 |
|
|
5692 |
my $token = "NO TOKEN YET";
|
|
5693 |
|
|
5684 | 5694 |
if ( $ENV{'HTTP_AUTHORIZATION'} ) { |
5685 | 5695 |
my @token_parts = split(/ /, $ENV{'HTTP_AUTHORIZATION'}); |
5686 | 5696 |
$token = @token_parts[1]; |
5687 | 5697 |
} |
5688 |
|
|
5698 |
|
|
5689 | 5699 |
my $der_cert_file; |
5690 | 5700 |
my $signing_cert; |
5691 |
|
|
5701 |
|
|
5692 | 5702 |
# If we don't already have the CN signing cert, get it |
5693 | 5703 |
if ( ! -e $der_file_path ) { |
5694 | 5704 |
getSigningCertificate(); |
5695 |
|
|
5705 |
|
|
5696 | 5706 |
} |
5697 |
|
|
5707 |
|
|
5698 | 5708 |
# Read the DER-encoded certificate |
5699 | 5709 |
open($der_cert_file, "<", $der_file_path) |
5700 | 5710 |
or die "\nCould not open DER certificate file: $!\n"; |
... | ... | |
5702 | 5712 |
read($der_cert_file, $signing_cert, 4096) |
5703 | 5713 |
or die "Problem reading the DER-encoded server cert: $!\n" if $!; |
5704 | 5714 |
close($der_cert_file); |
5705 |
|
|
5715 |
|
|
5706 | 5716 |
my $cert = Crypt::X509->new(cert=>$signing_cert); |
5707 |
|
|
5708 |
# Decode the token using Crypt::JWT
|
|
5717 |
|
|
5718 |
# Decode the token using Crypt::JWT |
|
5709 | 5719 |
eval{ $token_info = decode_jwt(token=>$token, key=>$cert) }; |
5710 |
if ( ! $@ ) {
|
|
5720 |
if ( ! $@ ) { |
|
5711 | 5721 |
$$token_info{isValid} = 1; |
5712 |
|
|
5722 |
|
|
5713 | 5723 |
} else { |
5724 |
debug("There was a problem parsing the token: $token"); |
|
5714 | 5725 |
debug($@); |
5715 |
|
|
5726 |
|
|
5716 | 5727 |
} |
5717 |
|
|
5728 |
|
|
5718 | 5729 |
return $token_info; |
5719 |
|
|
5730 |
|
|
5720 | 5731 |
} |
5721 | 5732 |
|
5722 | 5733 |
################################################################################ |
... | ... | |
5727 | 5738 |
# |
5728 | 5739 |
################################################################################ |
5729 | 5740 |
sub validateSession() { |
5730 |
|
|
5741 |
|
|
5731 | 5742 |
if ( $debug_enabled ) { |
5732 | 5743 |
debug('validateSession() called.'); |
5733 | 5744 |
} |
5734 |
|
|
5745 |
|
|
5735 | 5746 |
my $token_info = getTokenInfo(); |
5736 | 5747 |
my $session = CGI::Session->load(); |
5748 |
|
|
5737 | 5749 |
my $valid = 0; |
5738 |
|
|
5750 |
|
|
5739 | 5751 |
if ( $token_info->{"isValid"} ) { |
5740 | 5752 |
$valid = 1; |
5741 | 5753 |
if ( $debug_enabled ) { |
5742 | 5754 |
debug('The auth token session is valid.'); |
5743 |
|
|
5755 |
|
|
5744 | 5756 |
} |
5745 |
|
|
5746 |
} elsif ( ! $session->is_empty && ! $session->is_expired ) {
|
|
5757 |
|
|
5758 |
} elsif ( $session->is_empty && ! $session->is_expired ) { |
|
5747 | 5759 |
$valid = 1; |
5748 | 5760 |
if ( $debug_enabled ) { |
5749 | 5761 |
debug('The CGI session is valid.'); |
5750 |
|
|
5762 |
|
|
5751 | 5763 |
} |
5752 | 5764 |
} |
5753 |
|
|
5765 |
|
|
5754 | 5766 |
if ( $debug_enabled ) { |
5755 | 5767 |
if ( ! $valid ) { |
5756 | 5768 |
debug('The session is not valid.'); |
5757 |
|
|
5769 |
|
|
5758 | 5770 |
} |
5759 | 5771 |
} |
5760 |
|
|
5772 |
|
|
5761 | 5773 |
if ( $debug_enabled ) { |
5762 | 5774 |
while( my ($k, $v) = each %$token_info ) { |
5763 | 5775 |
debug("$k: $v"); |
5764 | 5776 |
} |
5765 | 5777 |
} |
5766 |
|
|
5767 |
|
|
5778 |
|
|
5779 |
|
|
5768 | 5780 |
return $valid; |
5769 | 5781 |
} |
5770 | 5782 |
|
... | ... | |
5774 | 5786 |
# |
5775 | 5787 |
################################################################################ |
5776 | 5788 |
sub hasValidAuthToken() { |
5777 |
|
|
5789 |
|
|
5778 | 5790 |
if ( $debug_enabled ) { |
5779 | 5791 |
debug('hasValidAuthToken() called.'); |
5780 | 5792 |
} |
5781 |
|
|
5793 |
|
|
5782 | 5794 |
my $token_info = getTokenInfo(); |
5783 | 5795 |
|
5784 | 5796 |
if ( $debug_enabled ) { |
5785 | 5797 |
debug("Auth token is valid: $token_info->{'isValid'}"); |
5786 | 5798 |
} |
5787 |
|
|
5799 |
|
|
5788 | 5800 |
return $token_info->{'isValid'}; |
5789 | 5801 |
} |
5802 |
|
Also available in: Unified diff
Validate the session during the modification stage, rather than just assuming a CGI session (support tokens too).
Also, fix the XML document validation issue where an <additionalParty> element is added prior to the <metadataProvider> element. This seems to be an intermittent issue, and may be due to more recent versions of perl returning hash contents more randomly than previous versions. The %orig hash passed in to personnelList() is assumed to be random now, and I just ensured the metadataProvider is first in the produced string.
https://github.nceas.ucsb.edu/KNB/arctic-data/issues/59
refs https://github.nceas.ucsb.edu/KNB/arctic-data/issues/42