Updated Federation SA an MA API

protogeni/lib/GeniMA.pm.in

@@ -49,36 +49,318 @@ use Data::Dumper;
 
 my $coder = Frontier::RPC2->new('use_objects' => 1);
 
+my $GENI_VERSION;
+
+sub SetGeniVersion($) 
+{
+    ($GENI_VERSION) = @_;
+}
+
 sub GetVersion()
 {
+    my $me = GeniAuthority->Lookup($ENV{'MYURN'});
+    if (!defined($me)) {
+        print STDERR "Could not find local authority object\n";
+        return GeniResponse->Create(GENIRESPONSE_ERROR);
+    }
+
+    my $api_version = "2";
+    if (defined($GENI_VERSION) && $GENI_VERSION == 1) {
+        $api_version = "1";
+    }
+
+    my $url = $me->url();
+    $url =~ s/ma$/geni-ma/;
+
     my $blob = {
-	"VERSION" => $coder->string("0.2"),
-	"CREDENTIAL_TYPES" => ["SFA"], #=> [$coder->string("3")]],
-	"SERVICES" => ["MEMBER"]
+        "VERSION" => $coder->string($api_version),
+        "URN" => $me->urn(),
+        "IMPLEMENTATION" => { "code_version" => $coder->string("0.2") },
+        "SERVICES" => [ "MEMBER", "KEY" ],
+        "CREDENTIAL_TYPES" => [ { "type" => "geni_sfa", "version" => $coder->string("3") },
+                                { "type" => "geni_abac", "version" => $coder->string("1") } 
+                              ],
+        "API_VERSIONS" => {
+            "1" => "$url/1",
+            "2" => "$url/2",
+        },
+        'FIELDS' => {
+            '_EMULAB_MEMBER_HRN' => { 
+                'OBJECT' => 'MEMBER',
+                'TYPE' => 'STRING',
+                'CREATE' => 'NOT ALLOWED',
+                'UPDATE' => $coder->boolean(0),
+                'MATCH' => $coder->boolean(0),
+                'PROTECT' => 'PUBLIC'
+            },
+            '_EMULAB_MEMBER_FULLNAME' => { 
+                'OBJECT' => 'MEMBER',
+                'TYPE' => 'STRING',
+                'CREATE' => 'REQUIRED',
+                'UPDATE' => $coder->boolean(0),
+                'MATCH' => $coder->boolean(0),
+                'PROTECT' => 'IDENTIFYING'
+            },
+            '_EMULAB_MEMBER_SSL_CERTIFICATE' => { 
+                'OBJECT' => 'MEMBER',
+                'TYPE' => 'CERTIFICATE',
+                'CREATE' => 'NOT ALLOWED',
+                'UPDATE' => $coder->boolean(0),
+                'MATCH' => $coder->boolean(0),
+                'PROTECT' => 'PUBLIC'
+            },
+            'MEMBER_EMAIL' => {
+                'OBJECT' => 'MEMBER',
+                'TYPE' => 'STRING',
+                'CREATE' => 'REQUIRED',
+                'UPDATE' => $coder->boolean(0),
+                'MATCH' => $coder->boolean(0),
+                'PROTECT' => 'IDENTIFYING'
+            },
+            'KEY_ID' => {
+                'OBJECT' => 'KEY',
+                'TYPE' => 'STRING',
+                'CREATE' => 'NOT ALLOWED',
+                'UPDATE' => $coder->boolean(0),
+                'MATCH' => $coder->boolean(0),
+            },
+            'KEY_TYPE' => {
+                'OBJECT' => 'KEY',
+                'TYPE' => 'STRING',
+                'CREATE' => 'REQUIRED',
+                'UPDATE' => $coder->boolean(0),
+                'MATCH' => $coder->boolean(0),
+            },
+            'KEY_PUBLIC' => {
+                'OBJECT' => 'KEY',
+                'TYPE' => 'STRING',
+                'CREATE' => 'REQUIRED',
+                'UPDATE' => $coder->boolean(0),
+                'MATCH' => $coder->boolean(0),
+            },
+            'KEY_PRIVATE' => {
+                'OBJECT' => 'KEY',
+                'TYPE' => 'STRING',
+                'CREATE' => 'NOT ALLOWED',
+                'UPDATE' => $coder->boolean(0),
+                'MATCH' => $coder->boolean(0),
+            },
+            'KEY_DESCRIPTION' => {
+                'OBJECT' => 'KEY',
+                'TYPE' => 'STRING',
+                'CREATE' => 'ALLOWED',
+                'UPDATE' => $coder->boolean(0),
+                'MATCH' => $coder->boolean(0),
+            },
+        }
     };
     return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
 }
 
-sub LookupPublic($)
+# Create in v2 of the API works for different objects.
+sub Create($$)
 {
-    my ($credential_args, $options) = @_;
+    my ($type, $credential_args, $options) = @_;
 
-    my ($match, $filter) = GeniStd::GetMatchFilter($options);
+    if (uc($type) eq 'MEMBER') {
+        return CreateMember($credential_args, $options);
+    }
+    if (uc($type) eq 'KEY') {
+        return CreateKey($credential_args, $options);
+    }
 
-    my $members = {};
-    foreach my $key (@{ $match }) {
-	my $geniuser = GeniUser->Lookup($key, 1);
-	if (defined($geniuser)) {
-	    my $completeblob = {
+	return GeniResponse->MalformedArgsResponse('create not supported for type "' . $type . '"');
+}
+sub Lookup($$)
+{
+    my ($type, $credential_args, $options) = @_;
+
+    if (uc($type) eq 'MEMBER') {
+        return LookupMembers($credential_args, $options);
+    }
+    if (uc($type) eq 'KEY') {
+        return LookupKeys($credential_args, $options);
+    }
+
+	return GeniResponse->MalformedArgsResponse('lookup not supported for type "' . $type . '"');
+}
+sub Update($$)
+{
+    my ($type, $urn, $credential_args, $options) = @_;
+
+    if (uc($type) eq 'MEMBER') {
+        return UpdateMember($urn, $credential_args, $options);
+    }
+    if (uc($type) eq 'KEY') {
+        return UpdateKey($urn, $credential_args, $options);
+    }
+
+	return GeniResponse->MalformedArgsResponse('update not supported for type "' . $type . '"');
+}
+sub Delete($$)
+{
+    my ($type, $urn, $credential_args, $options) = @_;
+
+    if (uc($type) eq 'KEY') {
+        return DeleteKey($urn, $credential_args, $options);
+    }
+
+	return GeniResponse->MalformedArgsResponse('delete not supported for type "' . $type . '"');
+}
+
+sub AddUserToBlob($$$$)
+{
+    my ($geniuser, $reply, $is_local_user, $filter) = @_;
+
+    # last and first name are not stored seperatly, so this is a guess.
+    # doesn't work well for all users, as last names can be multiple words
+    my @namelist = split(/ /, $geniuser->name());
+    my $lastname = pop(@namelist);
+    my $firstname = join(" ", @namelist);
+
+    my $publicblob = {
 		"MEMBER_URN"      => $geniuser->urn(),
 		"MEMBER_UID"      => $geniuser->uid(),
-		"MEMBER_USERNAME" => $geniuser->hrn()
+        "MEMBER_USERNAME" => $geniuser->uid(),
+        "_EMULAB_MEMBER_HRN" => $geniuser->hrn(),
+        "_EMULAB_MEMBER_SSL_CERTIFICATE" => 
+                '-----BEGIN CERTIFICATE-----'."\n" . 
+                  $geniuser->cert() . 
+                '-----END CERTIFICATE-----'."\n"
 	    };
+
+    my $identifyingblob = {
+        #since they are wrong sometimes, better not to return them
+        #"MEMBER_FIRSTNAME" => $firstname,
+        #"MEMBER_LASTNAME"  => $lastname,
+        "_EMULAB_MEMBER_FULLNAME" => $geniuser->name(),
+        "MEMBER_EMAIL"     => $geniuser->email()
+    };
+
+    my $privateblob = { };
+
+    my $completeblob = $is_local_user ? { %$publicblob, %$identifyingblob, %$privateblob } : $publicblob;
+
 	    my $blob = GeniStd::FilterFields($completeblob, $filter);
-	    $members->{$geniuser->urn()} = $blob;
+    $reply->{$geniuser->urn()} = $blob;
 	}
+
+sub LookupMembers($$)
+{
+    my ($credential_args, $options) = @_;
+
+    my ($credential,$speaksfor) = GeniStd::CheckCredentials(GeniStd::FilterCredentials($credential_args));
+    ($credential, $speaksfor) = GeniStd::AddUserCredWhenSpeaksForOnly($credential, $speaksfor);
+    return $credential if (GeniResponse::IsResponse($credential));
+    return GeniResponse->MalformedArgsResponse("Missing self credential when looking up member") if (!defined($credential));
+   
+    my $this_user = GeniUser->Lookup((defined($speaksfor) ?
+			  $speaksfor->target_urn() : $ENV{'GENIURN'}), 1);
+
+    my $is_local_user = defined($this_user);
+
+    $is_local_user = 0 unless 
+    $credential->HasPrivilege( "authority" ) or
+	$credential->HasPrivilege( "resolve" );
+
+    my ($match, $filter) = GeniStd::GetMatchFilter($options);
+
+    my $checkRes = GeniStd::CheckMatchAllowed('lookup MEMBER', $match, 
+        ['MEMBER_URN', 'MEMBER_USERNAME', 'MEMBER_UID', '_EMULAB_MEMBER_HRN'],
+        ['_EMULAB_MEMBER_SSL_CERTIFICATE'], 
+        ['MEMBER_FIRSTNAME', 'MEMBER_LASTNAME', 'MEMBER_EMAIL']); 
+    return $checkRes if (GeniResponse::IsError($checkRes));
+
+    my $reply = {};
+    if (defined($match) && defined($match->{'MEMBER_URN'})) {
+        my $match_member_urns = $match->{'MEMBER_URN'};
+        foreach my $member_urn (@$match_member_urns) {
+            my $geniuser = GeniUser->Lookup($member_urn, 1);
+            if (defined($geniuser)) {
+                AddUserToBlob($geniuser, $reply, $is_local_user, $filter);
+    }
+        }
     }
-    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $members);
+    if (defined($match) && defined($match->{'_EMULAB_MEMBER_HRN'})) {
+        my $match_member_hrns = $match->{'_EMULAB_MEMBER_HRN'};
+        foreach my $member_hrn (@$match_member_hrns) {
+            if (index($member_hrn, '.') != -1) {
+                my $geniuser = GeniUser->Lookup($member_hrn, 1);
+                if (defined($geniuser)) {
+                    AddUserToBlob($geniuser, $reply, $is_local_user, $filter);
+                }
+            } else {
+                print STDERR "_EMULAB_MEMBER_HRN '$member_hrn' is ignored because it does not contain a dot char.\n";
+            }
+        }
+    }
+    if (defined($match) && defined($match->{'MEMBER_USERNAME'})) {
+        my $match_member_usernames = $match->{'MEMBER_USERNAME'};
+        foreach my $member_username (@$match_member_usernames) {
+            if (index($member_username, '.') == -1) {
+                my $geniuser = GeniUser->Lookup('.' . $member_username, 1);
+                if (defined($geniuser)) {
+                    AddUserToBlob($geniuser, $reply, $is_local_user, $filter);
+                }
+            } else {
+                print STDERR "MEMBER_USERNAME '$member_username' is ignored because it contains a dot char.\n";
+            }
+        }
+    }
+    if (defined($match) && defined($match->{'MEMBER_UID'})) {
+        my $match_member_uids = $match->{'MEMBER_UID'};
+        foreach my $member_uid (@$match_member_uids) {
+            if (index($member_uid, '.') == -1) {
+                my $geniuser = GeniUser->Lookup('.' . $member_uid, 1);
+                if (defined($geniuser)) {
+                    AddUserToBlob($geniuser, $reply, $is_local_user, $filter);
+                }
+            } else {
+                print STDERR "MEMBER_UID '$member_uid' is ignored because it contains a dot char.\n";
+            }
+        }
+    }
+    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $reply);
+}
+
+my @public_member_fields = ('MEMBER_URN', 'MEMBER_UID', 'MEMBER_USERNAME', '_EMULAB_MEMBER_HRN', '_EMULAB_MEMBER_SSL_CERTIFICATE');
+my @identifying_member_fields = ('MEMBER_EMAIL', '_EMULAB_MEMBER_FULLNAME');
+my @private_member_fields = ();
+
+sub RestrictFilter($$)
+{
+    my ($filter, $restriction) = @_;
+
+    if (!defined($filter) || scalar @{ $filter } == 0) {
+        return $restriction;
+    }
+
+    my $newfilter = [];
+
+    foreach my $f (@{ $filter }) {
+        if (grep ($_ eq $f, @{ $restriction })) {
+            push(@$newfilter, $f);
+        }
+    }
+
+    print STDOUT "Debug: filter=@$filter\n       newfilter=@$newfilter\n       restriction=@$restriction\n";
+
+    return $newfilter;
+}
+
+sub LookupPublic($)
+{
+    my ($credential_args, $options) = @_;
+
+    my ($match, $filter) = GeniStd::GetMatchFilter($options);
+
+    $filter = RestrictFilter($filter, [ @public_member_fields ]);
+    if (!defined($options)) {
+        $options = { };
+    }
+    $options->{'filter'} = $filter;
+
+    return LookupMembers($credential_args, $options);
 }
 
 sub LookupPrivate($$)
@@ -86,6 +368,7 @@ sub LookupPrivate($$)
     my ($credential_args, $options) = @_;
     my ($credential,$speaksfor) =
 	GeniStd::CheckCredentials(GeniStd::FilterCredentials($credential_args));
+    ($credential, $speaksfor) = GeniStd::AddUserCredWhenSpeaksForOnly($credential, $speaksfor);
     return $credential
 	if (GeniResponse::IsResponse($credential));
     return GeniResponse->MalformedArgsResponse("Missing self credential")
@@ -109,17 +392,16 @@ sub LookupPrivate($$)
 	$credential->HasPrivilege( "resolve" ) or
 	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
 				     "Insufficient privilege" );
+
     my ($match, $filter) = GeniStd::GetMatchFilter($options);
 
-    my $members = {};
-    foreach my $key (@{ $match }) {
-	my $geniuser = GeniUser->Lookup($key, 1);
-	if (defined($geniuser)) {
-	    my $blob = {};
-	    $members->{$geniuser->urn()} = $blob;
+    $filter = RestrictFilter($filter, [ @public_member_fields, @private_member_fields ]);
+    if (!defined($options)) {
+        $options = { };
 	}
-    }
-    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $members);
+    $options->{'filter'} = $filter;
+
+    return LookupMembers($credential_args, $options);
 }
 
 sub LookupIdentifying($$)
@@ -128,6 +410,7 @@ sub LookupIdentifying($$)
 
     my ($credential,$speaksfor) =
 	GeniStd::CheckCredentials(GeniStd::FilterCredentials($credential_args));
+    ($credential, $speaksfor) = GeniStd::AddUserCredWhenSpeaksForOnly($credential, $speaksfor);
     return $credential
 	if (GeniResponse::IsResponse($credential));
     return GeniResponse->MalformedArgsResponse("Missing self credential")
@@ -154,30 +437,20 @@ sub LookupIdentifying($$)
 
     my ($match, $filter) = GeniStd::GetMatchFilter($options);
 
-    my $members = {};
-    foreach my $key (@{ $match }) {
-	my $geniuser = GeniUser->Lookup($key, 1);
-	if (defined($geniuser)) {
-	    my @namelist = split(/ /, $geniuser->name());
-	    my $lastname = pop(@namelist);
-	    my $firstname = join(" ", @namelist);
-	    my $completeblob = {
-		"MEMBER_FIRSTNAME" => $firstname,
-		"MEMBER_LASTNAME"  => $lastname,
-		"MEMBER_EMAIL"     => $geniuser->email()
-	    };
-	    my $blob = GeniStd::FilterFields($completeblob, $filter);
-	    $members->{$geniuser->urn()} = $blob;
+    $filter = RestrictFilter($filter, [ @public_member_fields, @identifying_member_fields ]);
+    if (!defined($options)) {
+        $options = { };
 	}
-    }
-    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $members);
+    $options->{'filter'} = $filter;
+
+    return LookupMembers($credential_args, $options);
 }
 
 sub UpdateMember($$$)
 {
     my ($member_urn, $credential_args, $options) = @_;
     return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
-				"Update Member is Unimplemented");
+				"update MEMBER is unimplemented");
 }
 
 sub GetCredentials($$$)
@@ -191,16 +464,14 @@ sub GetCredentials($$$)
     my $credential_args = GeniStd::FilterCredentials($credential_args);
     if (@{ $credential_args }) {
 	($credential,$speaksfor) = GeniStd::CheckCredentials($credential_args);
-	return $credential
-	    if (GeniResponse::IsResponse($credential));
+        return $credential if (GeniResponse::IsResponse($credential));
     }
     my $args = { "urn" => $member_urn };
     if (defined($speaksfor)) {
 	$args->{"credential"} = $speaksfor->asString();
     }
     $credential = GeniSA::GetCredential($args);
-    return $credential
-	if (GeniResponse::IsError($credential));
+    return $credential if (GeniResponse::IsError($credential));
 
     my $blob = {
 	"geni_type" => "geni_sfa",
@@ -236,20 +507,12 @@ sub LookupKeys($$)
 {
     my ($credential_args, $options) = @_;
 
-    my ($credential,$speaksfor) =
-	GeniStd::CheckCredentials(GeniStd::FilterCredentials($credential_args));
-    return $credential
-	if (GeniResponse::IsResponse($credential));
-    return GeniResponse->MalformedArgsResponse("Missing self credential")
-	if (0 && !defined($credential));
+    my ($credential,$speaksfor) = GeniStd::CheckCredentials(GeniStd::FilterCredentials($credential_args));
+    ($credential, $speaksfor) = GeniStd::AddUserCredWhenSpeaksForOnly($credential, $speaksfor);
+    return GeniStd::WrapResponse($credential, 'lookup KEY encountered an error: ') if (GeniResponse::IsResponse($credential));
+    return GeniResponse->MalformedArgsResponse("Missing self credential") if (0 && !defined($credential));
    
-    #
-    # We need to enforce Emulab permissions here, since the credential
-    # allows anyone with a credential for this registry to lookup anyone
-    # else. Good feature of the Geni API.
-    #
-    my $this_user =
-	GeniUser->Lookup((defined($speaksfor) ?
+    my $this_user = GeniUser->Lookup((defined($speaksfor) ?
 			  $speaksfor->target_urn() : $ENV{'GENIURN'}), 1);
     if (!defined($this_user)) {
 	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
@@ -262,16 +525,61 @@ sub LookupKeys($$)
 	 return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
 				      "Insufficient privilege" ));
 
+    my ($match, $filter) = GeniStd::GetMatchFilter($options);
+
+    my $checkRes = GeniStd::CheckMatchAllowed('lookup KEY', $match, 
+        ['KEY_MEMBER'], 
+        [], 
+        ['KEY_ID', 'KEY_TYPE', 'KEY_PUBLIC', 'KEY_PRIVATE', 'KEY_DESCRIPTION']); 
+    return $checkRes if (GeniResponse::IsError($checkRes));
+    if (! defined($match->{'KEY_MEMBER'}) ) {
+        return GeniResponse->MalformedArgsResponse('Search is too broad: You are required to match on KEY_MEMBER');
+    }
+
+    my $blob = { };
+    if (defined($match) && defined($match->{'KEY_MEMBER'})) {
+        my $match_member_urns = $match->{'KEY_MEMBER'};
+        foreach my $member_urn (@$match_member_urns) {
+            my $geniuser = GeniUser->Lookup($member_urn, 1);
+
     my @keys;
-    if ($this_user->GetKeyBundle(\@keys) != 0) {
-	print STDERR "Could not get keys for $this_user\n";
+            if ($geniuser->GetKeyBundle(\@keys) != 0) {
+                print STDERR "Could not get keys for $geniuser\n";
 	return GeniResponse->Create(GENIRESPONSE_ERROR);	
     }
+
+            my ($server_auth, $server_type, $server_authname) = GeniHRN::Parse( $ENV{'MYURN'} );
+
+            my $i = 0;
     my @list = ();
     foreach my $key (@keys) {
-	push(@list, {"KEY_PUBLIC" => $key->{'key'} });
+                my $keyurn = GeniHRN::Generate($server_auth, 'key', $geniuser->uid() . '-' . $i);
+                my $keyblob = { 
+                    'KEY_MEMBER' => $geniuser->urn(), 
+                    'KEY_ID' => $keyurn,
+                    'KEY_TYPE' => 'openssh',
+                    'KEY_DESCRIPTION' => 'a SSH key of user '.$geniuser->uid(),
+                    'KEY_PUBLIC' => $key->{'key'} 
+                };
+                my $filteredkeyblob = GeniStd::FilterFields($keyblob, $filter);
+                if (defined($GENI_VERSION) && $GENI_VERSION == 2) {
+                    $blob->{$keyurn} = $filteredkeyblob;
+                } else {
+                    push(@list, $filteredkeyblob);
+    }
+
+                $i += 1;
+            }
+            if (defined($GENI_VERSION) && $GENI_VERSION == 2) {
+                #nothing to do
+            } else {
+                $blob->{ $geniuser->urn() } = \@list;
+            }
+        }
     }
-    my $blob = { $this_user->urn() => \@list };
     
     return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
 }
+
+# _Always_ make sure that this 1 is at the end of the file...
+1;

protogeni/lib/GeniSA.pm.in

@@ -72,6 +72,11 @@ my $PROTOGENI_URL  = "@PROTOGENI_URL@";
 my $RegisterNow    = 0;
 my $API_VERSION    = 1.01;
 
+my $allow_nonproject_slice_share    = 1;
+#$allow_nonproject_slice_share
+#  if set to true, users can share slices to users that are not in 
+#  the project of the slice
+
 #
 # Tell the client what API revision we support.  The correspondence
 # between revision numbers and API features is to be specified elsewhere.
@@ -441,25 +446,31 @@ sub Resolve($)
 # API says that the caller provides that, but I see that as being
 # silly and more work then the user needs to deal with. 
 #
-sub Register($)
+sub Register($) {
+	my ($argref) = @_;
+	return RegisterInternal($argref, undef);
+}
+sub RegisterInternal($$)
 {
     require Experiment;
     
     # FIXME once migration to URNs is complete, $type should be removed
     # (it's deduced automatically from the URN).
-    my ($argref) = @_;
+    my ($argref, $project_name) = @_;
     my $cred  = $argref->{'credential'};
     my $creds = $argref->{'credentials'};
     my $type  = $argref->{'type'};
     my $hrn   = $argref->{'hrn'};
     my $urn   = $argref->{'urn'};
 
-    if (! ((defined($hrn) || defined($urn)) &&
-	   (defined($cred) || defined($creds)))) {
-	return GeniResponse->MalformedArgsResponse();
+    if (! ((defined($hrn) || defined($urn)))) {
+	return GeniResponse->MalformedArgsResponse('hrn or urn argument required');
+    }
+    if (! (defined($cred) || defined($creds))) {
+	return GeniResponse->MalformedArgsResponse('credential or credentials argument required');
     }
     if (defined($urn)) {
-	return GeniResponse->MalformedArgsResponse()
+	return GeniResponse->MalformedArgsResponse('invalid urn "'.$urn.'"')
 	    if (!GeniHRN::IsValid($urn));
 	$hrn = undef;
     }
@@ -468,7 +479,7 @@ sub Register($)
 	$hrn = undef;
     }
     elsif (defined($hrn) && !($hrn =~ /^[-\w\.]*$/)) {
-	return GeniResponse->MalformedArgsResponse();
+	return GeniResponse->MalformedArgsResponse('invalid hrn "'.$hrn.'"');
     }
     elsif (! ($hrn =~ /^[-\w]+$/)) {
 	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
@@ -490,21 +501,43 @@ sub Register($)
 	$hrn  = $id;
     }
     elsif (!defined($type)) {
-	return GeniResponse->MalformedArgsResponse();
+	return GeniResponse->MalformedArgsResponse('type required');
     }
 
-    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
+    my ($server_auth, $server_type, $server_authname) = GeniHRN::Parse( $ENV{'MYURN'} );
+    my $authority;
+    if (defined($project_name)) {
+        my $subauth_urn = GeniHRN::Generate($server_auth . ':' . $project_name, $server_type, $server_authname);
+        $authority = GeniAuthority->Lookup($subauth_urn);
+    } else {
+        $authority = GeniAuthority->Lookup($ENV{'MYURN'});
+    }
     if (!defined($authority)) {
 	print STDERR "Could not find local authority object\n";
 	return GeniResponse->Create(GENIRESPONSE_ERROR);
     }
     my ($credential, $speaksfor);
     if (defined($cred)) {
+        if (defined($project_name)) {
+            #don't check sub authority when project_name is defined
+            $credential = GeniCredential::CheckCredential($cred);
+        } else {
 	$credential = GeniCredential::CheckCredential($cred, $authority);
     }
+    }
     else {
+        if (defined($project_name)) {
+            #don't check sub authority when project_name is defined
+            ($credential,$speaksfor) = GeniStd::CheckCredentials($creds);
+
+            #wvdemeer: AddUserCredWhenSpeaksForOnly automatically adds a user credential when only speaksfor is present and it is needed, allowed and possible.
+            #          note on error handling: if the credential provided to it is a response, it will just return that response.
+            ($credential, $speaksfor) = GeniStd::AddUserCredWhenSpeaksForOnly($credential, $speaksfor, $creds);
+        } else {
 	($credential,$speaksfor) = GeniStd::CheckCredentials($creds, $authority);
     }
+    }
+    
     return $credential
 	if (GeniResponse::IsResponse($credential));
    
@@ -526,12 +559,31 @@ sub Register($)
 				    "Who are you? No local record");