- Publicity: Public Only All
install-procs.tcl
Procs which may be invoked using similarly named elements in an install.xml file.
- Location:
- packages/acs-tcl/tcl/install-procs.tcl
- Created:
- 2004-06-16
- Author:
- Lee Denison <lee@thaum.net>
- CVS Identification:
$Id: install-procs.tcl,v 1.39 2024/09/11 06:15:48 gustafn Exp $
Procedures in this file
- install::xml::action::add-subsite-admin (public)
- install::xml::action::add-subsite-member (public)
- install::xml::action::ats-page (public)
- install::xml::action::call-tcl-proc (private)
- install::xml::action::create-package (public)
- install::xml::action::create-user (public)
- install::xml::action::install (public)
- install::xml::action::instantiate-object (private)
- install::xml::action::location (public)
- install::xml::action::mount (public)
- install::xml::action::mount-existing (public)
- install::xml::action::register-parameter (public)
- install::xml::action::relation-add (public)
- install::xml::action::relation-type (public)
- install::xml::action::rename-instance (public)
- install::xml::action::set-id (public)
- install::xml::action::set-join-policy (public)
- install::xml::action::set-parameter (public)
- install::xml::action::set-parameter-default (public)
- install::xml::action::set-permission (public)
- install::xml::action::set-theme (public)
- install::xml::action::source (private)
- install::xml::action::text (public)
- install::xml::action::unset-permission (public)
- install::xml::action::wizard (public)
- install::xml::object_id::admin-group (public)
- install::xml::object_id::application-group (public)
- install::xml::object_id::group (public)
- install::xml::object_id::member-group (public)
- install::xml::object_id::object (public)
- install::xml::object_id::package (public)
- install::xml::util::get_id (public)
Detailed information
install::xml::action::add-subsite-admin (public)
install::xml::action::add-subsite-admin node
Add a member to a subsite's admins group.
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::add-subsite-member (public)
install::xml::action::add-subsite-member node
Add a member to a subsites application group.
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::ats-page (public)
install::xml::action::ats-page node
Creates an ATS Page.
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::call-tcl-proc (private)
install::xml::action::call-tcl-proc node
Call an arbitrary Tcl library procedure. Parameters which have a name are called using the "-param" syntax. If there's no name given, the value is passed directly as a positional parameter. It is the user's responsibility to list all named parameters before any positional parameter (as is necessary if the proc is declared using ad_proc). If a named parameter has an XML attribute declaring its type to be boolean, and the value is blank, the switch is passed without a value. Otherwise, the boolparam=value syntax is used. You can cheat and use this to execute arbitrary Tcl code if you dare, since Tcl commands are just procs ...
- Parameters:
- node (required)
- Author:
- Don Baccus donb@pacifier.com
- Created:
- 2008-12-04
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::create-package (public)
install::xml::action::create-package node
Create a relation type.
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::create-user (public)
install::xml::action::create-user node
Create a new user. local-p should be set to true when this action is used in the bootstrap install.xml - this ensures we call the auth::local api directly while the service contract has not been setup.
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::install (public)
install::xml::action::install node
Installs a package including dependencies.
<install package="package-key />
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::instantiate-object (private)
install::xml::action::instantiate-object node
Instantiate an object using package_instantiate_object. This will work for both PostgreSQL and Oracle if the proper object package and new() function have been defined.
- Parameters:
- node (required)
- Author:
- Don Baccus donb@pacifier.com
- Created:
- 2008-12-04
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::location (public)
install::xml::action::location node
Creates a URL location object.
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::mount (public)
install::xml::action::mount node
Mounts a package on a specified node.
<mount package="package-key instance-name="name" mount-point="url" />
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::mount-existing (public)
install::xml::action::mount-existing node
Mounts an existing package on a specified node.
<mount-existing package-id="package-id mount-point="url" />
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::register-parameter (public)
install::xml::action::register-parameter node
Registers a package parameter.
<register-parameter name="parameter" description="description" package-key="package-key" scope="instance or global" default-value="default-value" datatype="datatype" [ [ [ section="section" ] min-n-values="min-n-values" ] max-n-values="max-n-values" ] [ callback="callback" ] [ parameter-id="parameter-id" ]
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::relation-add (public)
install::xml::action::relation-add node
Create a relation.
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::relation-type (public)
install::xml::action::relation-type node
Create a relation type.
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::rename-instance (public)
install::xml::action::rename-instance node
Change the instance name of an existing package (such as the main subsite). Either the url (if it's mounted) or package_id of the package may be given.
<rename-instance package-id="package-id" url="url" instance-name="new instance name" />
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::set-id (public)
install::xml::action::set-id node
set a name/id pair for use in other install xml things
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::set-join-policy (public)
install::xml::action::set-join-policy node
Set the join policy of a group.
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::set-parameter (public)
install::xml::action::set-parameter node
Sets a package parameter.
<set-parameter name="parameter" [ package="package-key | url="package-url" ] type="[id|literal]" value="value" />
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::set-parameter-default (public)
install::xml::action::set-parameter-default node
Sets a package parameter default value
<set-parameter-default name="parameter" package-key="package-key" value="val">
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::set-permission (public)
install::xml::action::set-permission node
Sets permissions on an object.
<set-permissions grantee="party" privilege="package-key />
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::set-theme (public)
install::xml::action::set-theme node
Sets a theme for a subsite. If no subsite is specified it defaults to the main subsite "/". Valid themes are e.g. "openacs_bootstrap5", "openacs_bootstrap3", "default_plain", or default "tabbed".
<set-theme theme="theme" [ package="subsite ]
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::source (private)
install::xml::action::source node
Source an install.xml file, SQL file or Tcl script during execution of the current install.xml. If no type attribute is specified then this tag will attempt to guess type of the sourced script from the file extension, otherwise it defaults to install.xml. The type of the sourced script may be explicitly declared as 'tcl', 'sql' or 'install.xml' using the type attribute.
- Parameters:
- node (required)
- Author:
- Lee Denison lee@xarg.co.uk
- Created:
- 2005-02-04
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::text (public)
install::xml::action::text node
A documentation element which ignores its contents and does no processing.
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::unset-permission (public)
install::xml::action::unset-permission node
Revokes a permissions on an object - has no effect if the permission is not granted directly (i.e. does not act as negative permissions).
<unset-permissions grantee="party" privilege="package-key />
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::action::wizard (public)
install::xml::action::wizard node
Creates a wizard using the subtags for each step.
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::object_id::admin-group (public)
install::xml::object_id::admin-group node
- Parameters:
- node (required)
- Returns:
- an object_id for an admin group of a given package.
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::object_id::application-group (public)
install::xml::object_id::application-group node
Returns an object_id for an application group or relational segment of a given package. The node name is ignored so any node which provides the correct attributes may be used.
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::object_id::group (public)
install::xml::object_id::group node
Returns an object_id for a group or relational segment. The node name is ignored so any node which provides the correct attributes may be used.
<group id="group_id" [ type="group type" relation="relation-type" ] />
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::object_id::member-group (public)
install::xml::object_id::member-group node
- Parameters:
- node (required)
- Returns:
- an object_id for a member group of a given package.
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::object_id::object (public)
install::xml::object_id::object node
Returns a literal object_id for an object. use <object id="-100"> to return the literal id -100.
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::object_id::package (public)
install::xml::object_id::package node
Returns an object_id for a package specified in node. The node name is ignored so any node which provides the correct attributes may be used.
<package [ id="id" | key="package-key" | url="package-url" ] />
- Parameters:
- node (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
install::xml::util::get_id (public)
install::xml::util::get_id id
Returns an id from the global ids variable if it exists and attempts to find an acs_magic_object if not.
- Parameters:
- id (required)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
Content File Source
ad_library { Procs which may be invoked using similarly named elements in an install.xml file. @creation-date 2004-06-16 @author Lee Denison (lee@thaum.net) @cvs-id $Id: install-procs.tcl,v 1.39 2024/09/11 06:15:48 gustafn Exp $ } namespace eval install {} namespace eval install::xml {} namespace eval install::xml::util {} namespace eval install::xml::action {} namespace eval install::xml::object_id {} ad_proc -public install::xml::action::text { node } { A documentation element which ignores its contents and does no processing. } { return {} } ad_proc -private ::install::xml::action::source { node } { Source an install.xml file, SQL file or Tcl script during execution of the current install.xml. If no type attribute is specified then this tag will attempt to guess type of the sourced script from the file extension, otherwise it defaults to install.xml. The type of the sourced script may be explicitly declared as 'tcl', 'sql' or 'install.xml' using the type attribute. @author Lee Denison lee@xarg.co.uk @creation-date 2005-02-04 } { set src [apm_required_attribute_value $node src] set type [apm_attribute_value -default {} $node type] if {$type eq ""} { switch -glob $src { *.tcl { set type tcl } *.sql { set type sql } default { set type install.xml } } } set params [xml_node_get_children [lindex $node 0]] foreach param $params { if {[xml_node_get_name $param] ne "param"} { error "Unknown xml element \"[xml_node_get_name $param]\"" } set name [apm_required_attribute_value $param name] set id [apm_attribute_value -default {} $param id] set value [apm_attribute_value -default {} $param value] if {$id ne ""} { set value [install::xml::util::get_id $id] } set parameters($name) $value } switch -exact $type { tcl { set code [template::util::read_file $::acs::rootdir$src] set out [eval $code] } sql { db_source_sql_file $::acs::rootdir$src set out "$src completed" } install.xml { set binds [array get parameters] set out [apm::process_install_xml -nested $src $binds] } default { error "Unknown script type $type" } } return $out } ad_proc -public install::xml::action::install { node } { Installs a package including dependencies. <p><install package="<em>package-key</em> /></p> } { set package_key [apm_required_attribute_value $node package] apm_simple_package_install $package_key return } ad_proc -public install::xml::action::mount { node } { Mounts a package on a specified node. <p><mount package="<em>package-key</em> instance-name="<em>name</em>" mount-point="<em>url</em>" /></p> } { set package_key [apm_required_attribute_value $node package] set instance_name [apm_required_attribute_value $node instance-name] set id [apm_attribute_value -default "" $node id] set mount_point [apm_attribute_value -default "" $node mount-point] set context_id [apm_attribute_value -default "" $node context-id] set security_inherit_p [apm_attribute_value -default "t" $node security-inherit-p] set out [list] # Remove double slashes regsub -all -- {//} $mount_point "/" mount_point set mount_point [string trim $mount_point " /"] if {[string is space $mount_point] || $mount_point eq "/"} { array set site_node [site_node::get -url "/"] if {$site_node(object_id) ne ""} { ns_log Error "A package is already mounted at '$mount_point', ignoring mount command" lappend out "A package is already mounted at '$mount_point', ignoring mount command" set node_id "" } if {$context_id eq ""} { set context_id default_context } set context_id [install::xml::util::get_id $context_id] } else { set leaf_url $mount_point set parent_url "" regexp {(.*)/([^/]*)$} $mount_point match parent_url leaf_url set parent_id [site_node::get_node_id -url "/$parent_url"] # technically this isn't safe - between us checking that the node exists # and using it, the node may have been deleted. # We could "select for update" but since it's in a memory cache anyway, # it won't help us very much! # Instead we just press on and if there's an error handle it at the top level. # create the node and reget iff it doesn't exist if { [catch { array set site_node [site_node::get_from_url -exact -url "/$mount_point"] } error] } { set node_id [site_node::new -name $leaf_url -parent_id $parent_id] array set site_node [site_node::get_from_url -exact -url "/$mount_point"] } # There now definitely a node with that path if {$site_node(object_id) eq ""} { # no package mounted - good! set node_id $site_node(node_id) } else { ns_log Error "A package is already mounted at '$mount_point', ignoring mount command" lappend out "A package is already mounted at '$mount_point', ignoring mount command" set node_id "" } if {$context_id eq ""} { set context_id [install::xml::util::get_id $context_id] } } if {$node_id ne ""} { lappend out "Mounting new instance of package $package_key at /$mount_point" set package_id [site_node::instantiate_and_mount \ -node_id $node_id \ -context_id $context_id \ -node_name $mount_point \ -package_name $instance_name \ -package_key $package_key] if {![string is true -strict $security_inherit_p]} { permission::set_not_inherit -object_id $package_id } if {$id ne ""} { set ::install::xml::ids($id) $package_id } } return $out } ad_proc -public install::xml::action::mount-existing { node } { Mounts an existing package on a specified node. <p><mount-existing package-id="<em>package-id</em> mount-point="<em>url</em>" /></p> } { set package_id [apm_attribute_value -default "" $node package-id] set package_key [apm_attribute_value -default "" $node package-key] set mount_point [apm_attribute_value -default "" $node mount-point] set out [list] # Remove double slashes regsub -all -- {//} $mount_point "/" mount_point set mount_point [string trim $mount_point " /"] if {[string is space $mount_point] || $mount_point eq "/"} { array set site_node [site_node::get -url "/"] if {$site_node(object_id) ne ""} { ns_log Error "A package is already mounted at '$mount_point', ignoring mount command" lappend out "A package is already mounted at '$mount_point', ignoring mount command" set node_id "" } } else { set leaf_url $mount_point set parent_url "" regexp {(.*)/([^/]*)$} $mount_point match parent_url leaf_url set parent_id [site_node::get_node_id -url "/$parent_url"] # technically this isn't safe - between us checking that the node exists # and using it, the node may have been deleted. # We could "select for update" but since it's in a memory cache anyway, # it won't help us very much! # Instead we just press on and if there's an error handle it at the top level. # create the node and reget iff it doesn't exist if { [catch { array set site_node [site_node::get_from_url -exact -url "/$mount_point"] } error] } { set node_id [site_node::new -name $leaf_url -parent_id $parent_id] array set site_node [site_node::get_from_url -exact -url "/$mount_point"] } # There now definitely a node with that path if {$site_node(object_id) eq ""} { # no package mounted - good! set node_id $site_node(node_id) } else { ns_log Error "A package is already mounted at '$mount_point', ignoring mount command" lappend out "A package is already mounted at '$mount_point', ignoring mount command" set node_id "" } } if {$node_id ne ""} { lappend out "Mounting existing package $package_id at /$mount_point" if {$package_id ne ""} { set package_id [install::xml::util::get_id $package_id] } elseif {$package_key ne ""} { set package_id [apm_package_id_from_key $package_key] } set package_id [site_node::mount \ -node_id $node_id \ -object_id $package_id] } return $out } ad_proc -public install::xml::action::rename-instance { node } { Change the instance name of an existing package (such as the main subsite). Either the url (if it's mounted) or package_id of the package may be given. <p><rename-instance package-id="<em>package-id</em>" url="<em>url</em>" instance-name="<em>new instance name</em>" /></p> } { set package_id [apm_attribute_value -default "" $node package-id] set url [apm_attribute_value -default "" $node url] set instance_name [apm_required_attribute_value $node instance-name] if { $url ne "" && $package_id ne "" } { error "rename-instance specified with both url and package-id arguments" } elseif { $package_id ne "" } { set package_id [install::xml::util::get_id $package_id] set url [lindex [site_node::get_url_from_object_id -object_id $package_id] 0] } else { array set site_node [site_node::get_from_url -url $url -exact] set package_id $site_node(object_id) } apm_package_rename -package_id $package_id -instance_name $instance_name return [list "Package mounted at \"$url\" renamed to \"$instance_name\""] } ad_proc -public install::xml::action::create-package { node } { Create a relation type. } { variable ::install::xml::ids set package_key [apm_required_attribute_value $node package-key] set instance_name [apm_attribute_value -default "" $node name] set context_id [apm_attribute_value -default "" $node context-id] set security_inherit_p [apm_attribute_value -default "t" $node security-inherit-p] if {$context_id ne ""} { set context_id [install::xml::util::get_id $context_id] } set package_id [apm_package_instance_new \ -instance_name $instance_name \ -package_key $package_key \ -context_id $context_id] if {![string is true -strict $security_inherit_p]} { permission::set_not_inherit -object_id $package_id } if {![string is space $id]} { set ::install::xml::ids($id) $package_id } return } ad_proc -public install::xml::action::register-parameter { node } { Registers a package parameter. <p><register-parameter name="<em>parameter</em>" description="<em>description</em>" package-key="<em>package-key</em>" scope="<em>instance or global</em>" default-value="<em>default-value</em>" datatype="<em>datatype</em>" [ [ [ section="<em>section</em>" ] min-n-values="<em>min-n-values</em>" ] max-n-values="<em>max-n-values</em>" ] [ callback="<em>callback</em>" ] [ parameter-id="<em>parameter-id</em>" ]</p> } { set name [apm_required_attribute_value $node name] set desc [apm_required_attribute_value $node description] set package_key [apm_required_attribute_value $node package-key] set default_value [apm_required_attribute_value $node default-value] set scope [apm_attribute_value -default instance $node scope] set datatype [apm_required_attribute_value $node datatype] set min_n_values [apm_attribute_value -default {} $node min-n-values] set max_n_values [apm_attribute_value -default {} $node max-n-values] set section [apm_attribute_value -default {} $node section] set callback [apm_attribute_value -default {} $node callback] set parameter_id [apm_attribute_value -default {} $node parameter-id] set command "apm_parameter_register" if {$callback ne ""} { append command " -callback $callback" } if {$parameter_id ne ""} { append command " -parameter_id $parameter_id" } append command " -scope $scope $name \"$desc\" $package_key $default_value $datatype" if {$section ne ""} { append command " $section" if {$min_n_values ne ""} { append command " $min_n_values" if {$max_n_values ne ""} { append command " $max_n_values" } } } {*}$command return } ad_proc -public install::xml::action::set-parameter { node } { Sets a package parameter. <p><set-parameter name="<em>parameter</em>" [ package="<em>package-key</em> | url="<em>package-url</em>" ] type="<em>[id|literal]</em>" value="<em>value</em>" /></p> } { variable ::install::xml::ids set name [apm_required_attribute_value $node name] set type [apm_attribute_value -default "literal" $node type] set value [apm_attribute_value -default {} $node value] set package_ids [install::xml::object_id::package $node] foreach package_id $package_ids { switch -- $type { literal { parameter::set_value -package_id $package_id \ -parameter $name \ -value $value } id { parameter::set_value -package_id $package_id \ -parameter $name \ -value $ids($value) } } } return } ad_proc -public install::xml::action::set-parameter-default { node } { Sets a package parameter default value <code><set-parameter-default name="<em>parameter</em>" package-key="<em>package-key</em>" value="val"></code> } { set name [apm_required_attribute_value $node name] set package_key [apm_required_attribute_value $node package-key] set value [apm_attribute_value -default {} $node value] parameter::set_default \ -package_key $package_key \ -parameter $name \ -value $value return } ad_proc -public install::xml::action::set-permission { node } { Sets permissions on an object. <p><set-permissions grantee="<em>party</em>" privilege="<em>package-key</em> /></p> } { set privileges [apm_required_attribute_value $node privilege] set privilege_list [split $privileges ","] set grantees_node [xml_node_get_children_by_name [lindex $node 0] grantee] set grantees [xml_node_get_children [lindex $grantees_node 0]] foreach grantee $grantees { set party_id [apm_invoke_install_proc -type object_id -node $grantee] set objects_node [xml_node_get_children_by_name [lindex $node 0] object] set objects [xml_node_get_children [lindex $objects_node 0]] foreach object $objects { set object_id [apm_invoke_install_proc -type object_id \ -node $object] foreach privilege $privilege_list { permission::grant -object_id $object_id \ -party_id $party_id \ -privilege $privilege } } } return } ad_proc -public install::xml::action::unset-permission { node } { Revokes a permissions on an object - has no effect if the permission is not granted directly (i.e. does not act as negative permissions). <p><unset-permissions grantee="<em>party</em>" privilege="<em>package-key</em> /></p> } { set privileges [apm_required_attribute_value $node privilege] set privilege_list [split $privileges ","] set grantees_node [xml_node_get_children_by_name [lindex $node 0] grantee] set grantees [xml_node_get_children [lindex $grantees_node 0]] foreach grantee $grantees { set party_id [apm_invoke_install_proc -type object_id -node $grantee] set objects_node [xml_node_get_children_by_name [lindex $node 0] object] set objects [xml_node_get_children [lindex $objects_node 0]] foreach object $objects { set object_id [apm_invoke_install_proc -type object_id \ -node $object] foreach privilege $privilege_list { permission::revoke -object_id $object_id \ -party_id $party_id \ -privilege $privilege } } } return } ad_proc -public install::xml::action::set-join-policy { node } { Set the join policy of a group. } { set join_policy [apm_required_attribute_value $node join-policy] set objects [xml_node_get_children [lindex $node 0]] foreach object $objects { set group_id [apm_invoke_install_proc -type object_id -node $object] group::update -group_id $group_id [list join_policy $join_policy] } } ad_proc -public install::xml::action::create-user { node } { Create a new user. local-p should be set to true when this action is used in the bootstrap install.xml - this ensures we call the auth::local api directly while the service contract has not been setup. } { set email [apm_required_attribute_value $node email] set first_names [apm_required_attribute_value $node first-names] set last_name [apm_required_attribute_value $node last-name] set password [apm_required_attribute_value $node password] set salt [apm_attribute_value -default "" $node salt] set username [apm_attribute_value -default "" $node username] set screen_name [apm_attribute_value -default "" $node screen-name] set url [apm_attribute_value -default "" $node url] set secret_question [apm_attribute_value -default "" $node secret-question] set secret_answer [apm_attribute_value -default "" $node secret-answer] set id [apm_attribute_value -default "" $node id] set site_wide_admin_p [apm_attribute_value -default "" $node site-wide-admin] set local_p [apm_attribute_value -default 0 $node local-p] set local_p [string is true -strict $local_p] if {$salt ne ""} { set salt_password $password set password dummy } if {$local_p} { foreach elm [auth::get_all_registration_elements] { if { [info exists $elm] } { set user_info($elm) [set $elm] } } set user_info(email_verified_p) 1 array set result [auth::create_local_account \ -authority_id [auth::authority::local] \ -username $username \ -array user_info] if {$result(creation_status) eq "ok"} { # Need to find out which username was set set username $result(username) set call_args [list \ {} \ $username \ [auth::authority::local] \ $first_names \ $last_name \ $screen_name \ $email \ $url \ $password \ $secret_question \ $secret_answer] array set result [acs_sc::invoke \ -contract "auth_registration" \ -operation "Register" \ -impl local \ -call_args $call_args] } } else { array set result [auth::create_user -email $email \ -first_names $first_names \ -last_name $last_name \ -password $password \ -username $username \ -screen_name $screen_name \ -url $url \ -secret_question $secret_question \ -secret_answer $secret_answer \ -email_verified_p 1 \ -nologin \ ] } if {$result(creation_status) eq "ok"} { if {[string is true -strict $site_wide_admin_p]} { permission::grant -object_id [acs_magic_object "security_context_root"] \ -party_id $result(user_id) -privilege "admin" } if {$salt ne ""} { set user_id $result(user_id) db_dml set_real_passsword { UPDATE users SET salt = :salt, password = :salt_password WHERE user_id = :user_id } } if {$id ne ""} { set ::install::xml::ids($id) $result(user_id) } return [list $result(creation_message)] } else { ns_log error "create-user: $result(creation_status): $result(creation_message)" return } } ad_proc -public install::xml::action::add-subsite-member { node } { Add a member to a subsites application group. } { set member_state [apm_attribute_value -default "" $node member-state] set group_id [::install::xml::object_id::application-group $node] set user_nodes [xml_node_get_children [lindex $node 0]] foreach node $user_nodes { if {[xml_node_get_name $node] ne "user"} { error "Unknown xml element \"[xml_node_get_name $node]\"" } set user_id [::install::xml::object_id::object $node] group::add_member -user_id $user_id \ -group_id $group_id \ -member_state $member_state \ -no_perm_check } return } ad_proc -public install::xml::action::add-subsite-admin { node } { Add a member to a subsite's admins group. } { set member_state [apm_attribute_value -default "" $node member-state] # group id is registered using the package id set package_id [install::xml::object_id::package $node] set group_id [subsite::get_admin_group -package_id $package_id] set user_nodes [xml_node_get_children [lindex $node 0]] foreach node $user_nodes { if {[xml_node_get_name $node] ne "user"} { error "Unknown xml element \"[xml_node_get_name $node]\"" } set user_id [::install::xml::object_id::object $node] group::add_member -user_id $user_id \ -group_id $group_id \ -member_state $member_state \ -no_perm_check } return } ad_proc -public install::xml::action::relation-type { node } { Create a relation type. } { set rel_type [apm_required_attribute_value $node rel-type] set pretty_name [apm_required_attribute_value $node pretty-name] set pretty_plural [apm_required_attribute_value $node pretty-plural] set object_type_one [apm_required_attribute_value $node object-type-one] set min_n_rels_one [apm_required_attribute_value $node min-n-rels-one] set max_n_rels_one [apm_attribute_value -default "" $node max-n-rels-one] set object_type_two [apm_required_attribute_value $node object-type-two] set min_n_rels_two [apm_required_attribute_value $node min-n-rels-two] set max_n_rels_two [apm_attribute_value -default "" $node max-n-rels-two] rel_types::new $rel_type \ $pretty_name \ $pretty_plural \ $object_type_one \ $min_n_rels_one \ $max_n_rels_one \ $object_type_two \ $min_n_rels_two \ $max_n_rels_two return } ad_proc -public install::xml::action::relation-add { node } { Create a relation. } { set rel_type [apm_required_attribute_value $node rel-type] set object_one [apm_required_attribute_value $node object-one] set object_two [apm_required_attribute_value $node object-two] relation_add $rel_type $object_one $object_two return } ad_proc -public install::xml::action::ats-page { node } { Creates an ATS Page. } { set id [apm_attribute_value -default "" $node id] set package [apm_attribute_value -default "" $node package] set context [apm_attribute_value -default "" $node context] set path [apm_attribute_value $node path] if {$context ne ""} { set context [install::xml::util::get_id $context] } if {$package ne ""} { set package [install::xml::util::get_id $package] } set extension "*" regexp {(.*)\.(.*)} $path match path extension set result [db_string get_type_select { select page_id from ats_pages where path = :path} -default ""] if {$result eq ""} { set result [location::ats::create_template -path $path \ -extension $extension \ -package_id $package \ -context_id $context] } if {$id ne ""} { set ::install::xml::ids($id) $result } return } ad_proc -public install::xml::action::location { node } { Creates a URL location object. } { set id [apm_attribute_value -default "" $node id] set parent [apm_attribute_value -default "" $node parent] set name [apm_attribute_value -default "" $node name] set package [apm_attribute_value -default "" $node package] set context [apm_attribute_value -default "" $node context] set model [apm_attribute_value -default "" $node model] set view [apm_attribute_value -default "" $node view] set controller [apm_attribute_value -default "" $node controller] set path_arg [apm_attribute_value -default "" $node path-arg] set child_arg [apm_attribute_value -default "" $node child-arg] set directory_p [apm_attribute_value -default "t" $node directory-p] set title [apm_attribute_value -default "" $node title] if {$parent ne ""} { set parent [install::xml::util::get_id $parent] } if {$context ne ""} { set context [install::xml::util::get_id $context] } if {$package ne ""} { set package [install::xml::util::get_id $package] } if {$model ne ""} { set model [install::xml::util::get_id $model] } if {$view ne ""} { set view [install::xml::util::get_id $view] } set directory_p [string is true -strict $directory_p] set location_id [location::create -parent_id $parent \ -name $name \ -title $title \ -model_id $model \ -view_id $view \ -controller $controller \ -path_arg $path_arg \ -package_id $package \ -context_id $context \ -directory_p $directory_p] set children [xml_node_get_children [lindex $node 0]] foreach child $children { switch -exact -- [xml_node_get_name $child] { param { set name [apm_required_attribute_value $child name] set value [apm_attribute_value -default "" $child value] set type [apm_attribute_value -default literal $child type] set subtree_p [apm_attribute_value -default f $child subtree-p] set subtree_p [string is true -strict $subtree_p] if {$type eq "id"} { set value [install::xml::util::get_id $value] } location::parameter::create -location_id $location_id \ -name $name \ -value $value \ -subtree_p $subtree_p } forward { set name [apm_required_attribute_value $child name] set url [apm_required_attribute_value $child url] set exports [apm_attribute_value -default "" $child exports] set subtree_p [apm_attribute_value -default f $child subtree-p] set subtree_p [string is true -strict $subtree_p] location::parameter::create -location_id $location_id \ -name "forward::$name" \ -value $url \ -subtree_p $subtree_p if {$exports ne ""} { location::parameter::create -location_id $location_id \ -name "forward::${name}::exports" \ -value $exports \ -subtree_p $subtree_p } } location { xml_node_set_attribute $child parent $location_id if {$child_arg ne ""} { xml_node_set_attribute $child path-arg $child_arg } if {$package ne "" && ![xml_node_has_attribute $child package-id]} { xml_node_set_attribute $child package-id $package } if {$context ne "" && ![xml_node_has_attribute $child context-id]} { xml_node_set_attribute $child context-id $parent_id } apm_invoke_install_proc -node $child } default { error "Unknown xml element \"[xml_node_get_name $child]\"" } } } if {$id ne ""} { set ::install::xml::ids($id) $location_id } return $location_id } ad_proc -public install::xml::action::wizard { node } { Creates a wizard using the subtags for each step. } { set id [apm_attribute_value -default "" $node id] set name [apm_attribute_value -default "" $node name] set package [apm_attribute_value -default "" $node package] set context [apm_attribute_value -default "" $node context] set title [apm_attribute_value -default "" $node title] set child_arg [apm_attribute_value -default "" $node child-arg] set process [apm_attribute_value -default "" $node process] if {$context ne ""} { set context [install::xml::util::get_id $context] } if {$package ne ""} { set package [install::xml::util::get_id $package] } set parent_id [location::create -parent_id "" \ -name $name \ -title $title \ -model_id "" \ -view_id "" \ -controller "" \ -path_arg "" \ -package_id $package \ -context_id $context] if {$process ne ""} { location::parameter::create -location_id $parent_id \ -name "wizard::process" \ -subtree_p t \ -value $process } set steps [xml_node_get_children [lindex $node 0]] foreach step $steps { if {[xml_node_get_name $step] ne "step"} { error "Unknown xml element \"[xml_node_get_name $step]\"" } set step_export [apm_attribute_value -default "" $step exports] set step_export_proc [apm_attribute_value -default "" $step exports-proc] xml_node_set_attribute $step parent $parent_id if {$child_arg ne ""} { xml_node_set_attribute $step path-arg $child_arg } if {$package ne "" && ![xml_node_has_attribute $step package-id]} { xml_node_set_attribute $step package-id $package } if {$context ne "" && ![xml_node_has_attribute $step context-id]} { xml_node_set_attribute $step context-id $parent_id } set directory_p [apm_attribute_value -default f $step directory-p] xml_node_set_attribute $step directory-p \ [string is true -strict $directory_p] set step_id [::install::xml::action::location $step] if {$step_export ne ""} { location::parameter::create -location_id $step_id \ -name "wizard::exports" \ -subtree_p t \ -value $step_export } if {$step_export_proc ne ""} { location::parameter::create -location_id $step_id \ -name "wizard::exports::proc" \ -subtree_p t \ -value $step_export_proc } } if {$id ne ""} { set ::install::xml::ids($id) $parent_id } return $parent_id } ad_proc -private ::install::xml::action::call-tcl-proc { node } { Call an arbitrary Tcl library procedure. Parameters which have a name are called using the "-param" syntax. If there's no name given, the value is passed directly as a positional parameter. It is the user's responsibility to list all named parameters before any positional parameter (as is necessary if the proc is declared using ad_proc). If a named parameter has an XML attribute declaring its type to be boolean, and the value is blank, the switch is passed without a value. Otherwise, the boolparam=value syntax is used. You can cheat and use this to execute arbitrary Tcl code if you dare, since Tcl commands are just procs ... @author Don Baccus donb@pacifier.com @creation-date 2008-12-04 } { set cmd [list [apm_required_attribute_value $node name]] set params [xml_node_get_children [lindex $node 0]] foreach param $params { if {[xml_node_get_name $param] ne "param"} { error "Unknown xml element \"[xml_node_get_name $param]\"" } set name [apm_attribute_value -default {} $param name] set id [apm_attribute_value -default {} $param id] set value [apm_attribute_value -default {} $param value] set type [apm_attribute_value -default {} $param type] if {$id ne ""} { set value [install::xml::util::get_id $id] } if { $name ne "" && $type eq "boolean" } { if { $value ne "" } { lappend cmd -${name}=$value } else { lappend cmd -$name } } else { if { $name ne "" } { lappend cmd -$name } lappend cmd $value } } set result [{*}$cmd] set id [apm_attribute_value -default "" $node id] if {$id ne ""} { set ::install::xml::ids($id) $result } return } ad_proc -private ::install::xml::action::instantiate-object { node } { Instantiate an object using package_instantiate_object. This will work for both PostgreSQL and Oracle if the proper object package and new() function have been defined. @author Don Baccus donb@pacifier.com @creation-date 2008-12-04 } { set type [apm_required_attribute_value $node type] set params [xml_node_get_children [lindex $node 0]] set var_list {} foreach param $params { if {[xml_node_get_name $param] ne "param"} { error "Unknown xml element \"[xml_node_get_name $param]\"" } set name [apm_required_attribute_value $param name] set id [apm_attribute_value -default {} $param id] set value [apm_attribute_value -default {} $param value] if {$id ne ""} { set value [install::xml::util::get_id $id] } lappend var_list [list $name $value] } set object_id [package_instantiate_object -var_list $var_list $type] set id [apm_attribute_value -default "" $node id] if {$id ne ""} { set ::install::xml::ids($id) $object_id } return } ad_proc -public install::xml::object_id::package { node } { Returns an object_id for a package specified in node. The node name is ignored so any node which provides the correct attributes may be used. <p><package [ id="<em>id</em>" | key="<em>package-key</em>" | url="<em>package-url</em>" ] /></p> } { set id [apm_attribute_value -default "" $node package-id] set url [apm_attribute_value -default "" $node url] set package_key [apm_attribute_value -default "" $node package-key] if {$package_key eq ""} { set package_key [apm_attribute_value -default "" $node package] } # Remove double slashes regsub -all -- {//} $url "/" url if { $package_key ne "" && $url ne "" } { error "set-parameter: Can't specify both package and url for $url and $package_key" } elseif { $id ne "" } { if {[string is integer $id]} { return $id } else { return [install::xml::util::get_id $id] } } elseif { $package_key ne "" } { return [apm_package_ids_from_key -package_key $package_key] } else { return [site_node::get_object_id \ -node_id [site_node::get_node_id -url $url]] } } ad_proc -public install::xml::object_id::group { node } { Returns an object_id for a group or relational segment. The node name is ignored so any node which provides the correct attributes may be used. <p><group id="<em>group_id</em>" [ type="<em>group type</em>" relation="<em>relation-type</em>" ] /></p> } { set group_type [apm_attribute_value -default "group" $node type] set relation_type [apm_attribute_value -default "membership_rel" $node relation] if {$group_type eq "group"} { set id [apm_required_attribute_value $node group-id] } elseif {$group_type eq "rel_segment"} { set id [apm_required_attribute_value $node parent-id] } set group_id [install::xml::util::get_id $id] if {$group_type eq "group"} { return $group_id } elseif {$group_type ne "rel_segment"} { return [group::get_rel_segment -group_id $group_id -type $relation_type] } } ad_proc -public install::xml::object_id::application-group { node } { Returns an object_id for an application group or relational segment of a given package. The node name is ignored so any node which provides the correct attributes may be used. } { set group_type [apm_attribute_value -default "group" $node type] set relation_type [apm_attribute_value -default "membership_rel" $node relation] set package_id [::install::xml::object_id::package $node] set group_id [application_group::group_id_from_package_id \ -package_id $package_id] if {$group_type eq "group"} { return $group_id } elseif {$group_type eq "rel_segment"} { return [group::get_rel_segment -group_id $group_id -type $relation_type] } } ad_proc -public install::xml::object_id::member-group { node } { @return an object_id for a member group of a given package. } { set package_id [::install::xml::object_id::package $node] return [subsite::get_member_group -package_id $package_id] } ad_proc -public install::xml::object_id::admin-group { node } { @return an object_id for an admin group of a given package. } { set package_id [::install::xml::object_id::package $node] return [subsite::get_admin_group -package_id $package_id] } ad_proc -public install::xml::object_id::object { node } { Returns a literal object_id for an object. use <object id="-100"> to return the literal id -100. } { set id [apm_required_attribute_value $node id] if {[string is integer $id]} { return $id } else { return [install::xml::util::get_id $id] } } ad_proc -public ::install::xml::action::set-id { node } { set a name/id pair for use in other install xml things } { set name [apm_required_attribute_value $node name] set value [apm_required_attribute_value $node value] variable ::install::xml::ids set ids($name) $value } ad_proc -public install::xml::action::set-theme { node } { Sets a theme for a subsite. If no subsite is specified it defaults to the main subsite "/". Valid themes are e.g. "openacs_bootstrap5", "openacs_bootstrap3", "default_plain", or default "tabbed". <p><set-theme theme="<em>theme</em>" [ package="<em>subsite</em> ] </p> } { variable ::install::xml::ids set theme [apm_required_attribute_value $node theme] set subsite [apm_attribute_value -default "/" $node subsite] # # Get subsite_id from "subsite" path # set subsite_id [site_node::get_object_id \ -node_id [site_node::get_node_id -url $subsite]] subsite::set_theme -subsite_id $subsite_id -theme $theme } ad_proc -public install::xml::util::get_id { id } { Returns an id from the global ids variable if it exists and attempts to find an acs_magic_object if not. } { variable ::install::xml::ids if {[catch { if {[string is integer $id]} { set result $id } elseif {[info exists ids($id)]} { set result $ids($id) } else { set result [acs_magic_object $id] } } err]} { error "$id is not an integer, is not defined in this install.xml, and is not an acs_magic_object" } return $result } # Local variables: # mode: tcl # tcl-indent-level: 4 # indent-tabs-mode: nil # End: