Forum OpenACS Improvement Proposals (TIPs): Re: TIP #81: User Merge account support

Posted by Enrique Catalan on
Andrew: the new SC operation is required because we need to manage the merge operation in authentication. By now, we have two implementations; One for local and the other one for auth-ldap.

This is the part of the merge process where we have to be careful. This time i'm posting some tcl code to get it clearly:

Adding the new operation :

ad_proc -private auth::local::authentication::register_impl {} {
    Register the 'local' implementation of the 'auth_authentication' service contract.

    @return impl_id of the newly created implementation.
} {
    set spec {
        contract_name "auth_authentication"
        owner "acs-authentication"
        name "local"
        pretty_name "Local"
        aliases {
            MergeUser auth::local::authentication::MergeUser
            Authenticate auth::local::authentication::Authenticate
            GetParameters auth::local::authentication::GetParameters

    return [acs_sc::impl::new_from_spec -spec $spec]

One implementation is:

ad_proc -private auth::local::authentication::MergeUser {
    {authority_id ""}
} {
    Merge operation of the auth_authentication
    Here we will merge the basic user info
    and merge the email and all related with the username
} {
    ns_log Notice "Starting local merge user"
    db_transaction {
        ns_log Notice "Merging user portrait"
        if { ( ![db_0or1row to_user_portrait { *SQL*} ] ) &&  ( [db_0or1row from_user_portrait { *SQL* } ] )  } {
            db_dml upd_portrait { *SQL* }
            ns_log Notice "Merging user portrait"

        # get the permissions of the from_user_id
        # and grant them to the to_user_id
        db_foreach getfromobjs { *SQL* } {
            # revoke the permissions from from_user_id
            permission::revoke -object_id $from_oid -party_id $from_user_id -privilege $from_priv
            if { ![db_string getdata { *SQL* } ] } {
                # grant the permissions to to_user_id
                permission::grant -object_id $from_oid -party_id $to_user_id -privilege $from_priv

        lappend res "acs_permissions merged"

        ns_log notice "   Merging acs_objects ..."

        db_dml acs_objs_upd  { *SQL* }

        set msg "acs_objects merged"
        ns_log notice $msg
        lappend res $msg

        ns_log notice "   Merging user,names and email..."
        ns_log Notice "     Deleting user $from_user_id. It will be merged with user_id $to_user_id"

        set new_username "merged_$from_user_id"
        append new_username "_$to_user_id"

        # Shall we keep the domain for email?
        # Actually, the username 'merged_xxx_yyy'
        # won't be an email, so we will keep it without
        # domain
        set new_email "$new_username"

        set rel_id [db_string getrelid { *SQL* }]
        membership_rel::change_state -rel_id $rel_id -state "merged"
        ns_log Notice "     state changed, rel_id $rel_id, from_user_id ; $from_user_id"

        acs_user::update -user_id $from_user_id -username "$new_username" -screen_name "$new_username"
        party::update -party_id $from_user_id -email "$new_email"

        set msg "     username and member state done"
        ns_log notice $msg
        lappend res $msg
    lappend res "local MergeUser is complete"
    ns_log notice $res
    return $res

The script for upgrade is in .../acs-authentication/tcl/apm-callback-procs.tcl, the code is in auth::after_upgrade callback and it is:

        5.1.4 5.1.5 {
                db_transaction {
                    # Following the above steps to upgrade a SC
                    # I will add support to MergeUser operation (quio)
                    ns_log notice "Starting Upgrade"
                    acs_sc::contract::operation::new \
                        -contract_name "auth_authentication" \
                        -operation "MergeUser" \
                        -input { from_user_id:integer to_user_id:integer authority_id:integer } \
                        -output {} \
                        -description "Merges two accounts given the user_id of each one"
                    acs_sc::impl::alias::new \
                        -contract_name "auth_authentication" \
                        -impl_name "LDAP" \
                        -operation "MergeUser" \
                        -alias "auth::ldap::authentication::MergeUser" \
                    acs_sc::impl::alias::new \
                        -contract_name "auth_authentication" \
                        -impl_name "local" \
                        -operation "MergeUser" \
                        -alias "auth::local::authentication::MergeUser" \
                    ns_log notice "Finishing upgrade"