Index: openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl,v diff -u -r1.115 -r1.116 --- openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 18 Apr 2018 09:09:12 -0000 1.115 +++ openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 23 Apr 2018 18:24:56 -0000 1.116 @@ -12,7 +12,7 @@ namespace eval apm::package_version::attributes {} namespace eval ::install::xml::action {} -ad_proc apm_scan_packages { +ad_proc apm_scan_packages { {-callback apm_dummy_callback} {-new:boolean} {path ""} @@ -49,7 +49,7 @@ continue } } - + # Locate the .info file for this package. if { [catch { set info_file [apm_package_info_file_path -path $path $package_key] } error] } { apm_callback_and_log -severity Warning $callback "Unable to locate specification file for package $package_key: $error" @@ -58,10 +58,10 @@ # We found the .info file. lappend new_spec_files $info_file } - + if { [llength $new_spec_files] == 0 } { ns_log Notice "apm_scan_packages: No new packages found in $path" - } + } return $new_spec_files } @@ -75,8 +75,8 @@ Returns 1 if the current system provides the dependency inquired about. Returns -1 if the version number is too low. Returns 0 otherwise. - @param dependency_list Specify this if you want to a check a list of dependencies of form - {dependency_name dependency_version} in addition to querying the database for what the + @param dependency_list Specify this if you want to a check a list of dependencies of form + {dependency_name dependency_version} in addition to querying the database for what the system currently provides. @param dependency_uri The dependency that is being checked. @param dependency_version The version of the dependency being checked. @@ -110,13 +110,13 @@ if { $provided_p } { ns_log Debug "apm_dependency_provided_p: Dependency satisfied in list of provisions." return 1 - } else { + } else { set old_version_p 1 } } } } - + if { $old_version_p} { return -1 } else { @@ -138,7 +138,7 @@ @param requires A list of requirements provided by the package.. @param dependency_p Can the package be installed without violating dependency checking. @param comment Some text about the package. Useful to explain why it fails dependency check. - @return a list whose first element is a package key and whose second element is a path + @return a list whose first element is a package key and whose second element is a path to the associated .info file. } { return [list $package_key $spec_file_path $embeds $extends $provides $requires $dependency_p $comment] @@ -253,7 +253,7 @@ ## Every time we satisfy another package, remove it from install_pend, and loop again. ## If we don't satisfy at least one more package, halt. ## install_in - Package info structures for packages that can be installed in a satisfactory order. - ## install_pend - Stores package info structures fro packages that might have their dependencies satisfied + ## install_pend - Stores package info structures fro packages that might have their dependencies satisfied ## by packages in the install set. ## extra_package_keys - package keys of extra packages to install to satisfy all requirements. @@ -264,8 +264,8 @@ foreach spec_file $spec_files { if { [catch { array set package [apm_read_package_info_file $spec_file] - if { ($package(initial-install-p) eq "t" || !$initial_install_p) - && [apm_package_supports_rdbms_p -package_key $package(package.key)] + if { ($package(initial-install-p) eq "t" || !$initial_install_p) + && [apm_package_supports_rdbms_p -package_key $package(package.key)] } { lappend install_pend [pkg_info_new \ $package(package.key) \ @@ -289,12 +289,12 @@ } } errmsg]} { # Failed to parse the specification file. - apm_callback_and_log $callback "$spec_file could not be parsed correctly. It is not being installed. + apm_callback_and_log $callback "$spec_file could not be parsed correctly. It is not being installed. The error: $errmsg" } } - # Outer loop tries to find a package from the pkg_info_all list to add if + # Outer loop tries to find a package from the pkg_info_all list to add if # we're stuck because of unsatisfied dependencies set updated_p 1 while { $updated_p } { @@ -309,7 +309,7 @@ foreach prov [pkg_info_provides $pkg_info] { lappend install_in_provides $prov } - } + } # Now determine if we can add another package to the install set. foreach pkg_info $install_pend { set satisfied_p 1 @@ -320,7 +320,7 @@ set satisfied_p 0 # Check to see if we've recorded it already set errmsg "Requires [lindex $req 0] of version >= [lindex $req 1]." - if { ![info exists install_error([pkg_info_key $pkg_info])] || + if { ![info exists install_error([pkg_info_key $pkg_info])] || $errmsg ni $install_error([pkg_info_key $pkg_info])} { lappend install_error([pkg_info_key $pkg_info]) $errmsg } @@ -346,10 +346,10 @@ } set updated_p 0 - + if { [info exists install_pend] && $install_pend ne "" && [llength $pkg_info_all] > 0 } { # Okay, there are some packages that could not be installed - + # Let's find a package, which # - have unsatisfied requirements # - and we have a package in pkg_info_all which provides what this package requires @@ -360,17 +360,17 @@ set counter 0 foreach pkg_info_add $pkg_info_all { # Will this package do anything to change whether this requirement has been satisfied? - if { [pkg_info_key $pkg_info_add] eq [lindex $req 0] + if { [pkg_info_key $pkg_info_add] eq [lindex $req 0] && [apm_dependency_provided_p -dependency_list [pkg_info_provides $pkg_info_add] \ - [lindex $req 0] [lindex $req 1]] == 1 + [lindex $req 0] [lindex $req 1]] == 1 } { # It sure does. Add it to list of packages to install lappend install_pend $pkg_info_add # Add it to list of extra package keys lappend extra_package_keys [pkg_info_key $pkg_info_add] - + # Remove it from list of packages that we can possibly install set pkg_info_all [lreplace $pkg_info_all $counter $counter] @@ -392,7 +392,7 @@ } } } - + set install_order(order) $install_in # Update all of the packages that cannot be installed. if { [info exists install_pend] && $install_pend ne "" } { @@ -413,13 +413,13 @@ {-package_keys:required} } { Checks dependencies and finds out which packages are required to install the requested packages. - In case some packages cannot be installed due to failed dependencies, it returns which packages out + In case some packages cannot be installed due to failed dependencies, it returns which packages out of the requested can be installed, and which packages, either originally requested or required by those, could not be installed, and why. @param package_keys The list of package_keys of the packages requested to be installed. - @param repository_array Name of an array in the caller's namespace containing the repository of + @param repository_array Name of an array in the caller's namespace containing the repository of available packages as returned by apm_get_package_repository. @return An array list with the following elements: @@ -428,18 +428,18 @@
  • status: 'ok' or 'failed'. -
  • install: If status is 'ok', this is the complete list of packages that need to be installed, +
  • install: If status is 'ok', this is the complete list of packages that need to be installed, in the order in which they need to be installed. If status is 'failed', the list of packages that can be installed. -
  • failed: If status is 'failed', an array list keyed by package_key of 2-tuples of +
  • failed: If status is 'failed', an array list keyed by package_key of 2-tuples of (required-uri, required-version) of requirements that could not be satisfied. -
  • packages: The list of package_keys of the packages touched upon, either because they - were originally requested, or because they were required. If status is 'ok', +
  • packages: The list of package_keys of the packages touched upon, either because they + were originally requested, or because they were required. If status is 'ok', will be identical to 'install'. - + @see apm_get_package_repository @@ -460,7 +460,7 @@ set pending_packages($package_key) 1 } - # 'installed_packages' is an array keyed by package_key with a value of 1 for each package + # 'installed_packages' is an array keyed by package_key with a value of 1 for each package # whose dependencies have been met and is ready to be installed array set installed_packages [list] @@ -481,7 +481,7 @@ ns_log notice "apm_dependency_check_new: STARTING DEPENDENCY CHECK [array names pending_packages]" - # Outer loop tries to find a package from the repository to add if + # Outer loop tries to find a package from the repository to add if # we're stuck because of unsatisfied dependencies while { $updated_p } { @@ -490,9 +490,9 @@ while { $updated_p && [array size pending_packages] > 0 } { set updated_p 0 - # Try to add a package from + # Try to add a package from foreach package_key [array names pending_packages] { - + if {![info exists repository($package_key)]} continue array unset version @@ -502,27 +502,27 @@ foreach req [concat $version(embeds) $version(extends) $version(requires)] { lassign $req req_uri req_version - if { ![info exists provided($req_uri)] + if { ![info exists provided($req_uri)] || [apm_version_names_compare $provided($req_uri) $req_version] == -1 } { ns_log Debug "apm_dependency_check_new: $package_key embeds, extends or requires $req_uri $req_version => failed" set satisfied_p 0 # Mark this as a requirement - if { ![info exists required($req_uri)] + if { ![info exists required($req_uri)] || [apm_version_names_compare $required($req_uri) $req_version] == -1 } { set required($req_uri) $req_version } } else { ns_log Debug "apm_dependency_check_new: $package_key embeds, extends or requires $req_uri $req_version => OK" } } - + if { $satisfied_p } { # Record as set to go set installed_packages($package_key) 1 - + # Remove from pending list unset pending_packages($package_key) @@ -544,8 +544,8 @@ } # If what we provide is required, and the required version is less than what we provide, # drop the requirement - if { [info exists required($prov_uri)] - && [apm_version_names_compare $required($prov_uri) $prov_version] <= 0 + if { [info exists required($prov_uri)] + && [apm_version_names_compare $required($prov_uri) $prov_version] <= 0 } { array unset required($prov_uri) } @@ -561,15 +561,15 @@ # not currently on the pending_package_keys list. set updated_p 0 - + if { [array size pending_packages] > 0 } { # There are packages that have unsatisfied dependencies # Those unmet requirements will be registered in the 'required' array - + # Let's find a package which satisfies at least one of the requirements in 'required' foreach package_key [array names repository] { - if { [info exists pending_packages($package_key)] + if { [info exists pending_packages($package_key)] || [info exists installed_packages($package_key)] } { # Packages already on the pending list, or already verified ok won't help us any continue @@ -591,8 +591,8 @@ foreach prov $version(provides) { lassign $prov prov_uri prov_version - if { [info exists required($prov_uri)] - && [apm_version_names_compare $required($prov_uri) $prov_version] <= 0 + if { [info exists required($prov_uri)] + && [apm_version_names_compare $required($prov_uri) $prov_version] <= 0 } { ns_log Debug "apm_dependency_check_new: Adding $package_key, as it provides $prov_uri $prov_version" @@ -602,7 +602,7 @@ # We've changed something set updated_p 1 - + # Let's try for another go at installing packages break } @@ -638,11 +638,11 @@ array unset version array set version $repository($package_key) - + # Find unsatisfied requirements foreach req [concat $version(embeds) $version(extends) $version(requires)] { lassign $req req_uri req_version - if { ![info exists provided($req_uri)] + if { ![info exists provided($req_uri)] || [apm_version_names_compare $provided($req_uri) $req_version] == -1 } { lappend failed($package_key) [list $req_uri $req_version] if { [info exists provided($req_uri)] } { @@ -659,7 +659,7 @@ set result(failed) [array get failed] } - + return [array get result] } @@ -694,8 +694,8 @@ basically what the old install xml action did. } { set install_spec_file [apm_package_info_file_path $package_key] - - if { [catch { + + if { [catch { array set package [apm_read_package_info_file $install_spec_file] } errmsg] } { # Unable to parse specification file. @@ -704,7 +704,7 @@ } if { ![apm_package_supports_rdbms_p -package_key $package(package.key)] - || [apm_package_installed_p $package(package.key)] + || [apm_package_installed_p $package(package.key)] } { ns_log notice "apm_simple_package_install: no need to install $package(package.key)" return @@ -713,17 +713,17 @@ set pkg_info_list [list] foreach spec_file [glob -nocomplain "$::acs::rootdir/packages/*/*.info"] { # Get package info, and find out if this is a package we should install - if { [catch { - array set package [apm_read_package_info_file $spec_file] + if { [catch { + array set package [apm_read_package_info_file $spec_file] } errmsg] } { # Unable to parse specification file. error "install: $spec_file could not be parsed correctly. The error: $errmsg" } if { [apm_package_supports_rdbms_p -package_key $package(package.key)] - && ![apm_package_installed_p $package(package.key)] + && ![apm_package_installed_p $package(package.key)] } { - # Save the package info, we may need it for dependency + # Save the package info, we may need it for dependency # satisfaction later lappend pkg_info_list [pkg_info_new $package(package.key) \ $spec_file \ @@ -751,15 +751,15 @@ } } -ad_proc -private apm_package_install { +ad_proc -private apm_package_install { {-enable:boolean} {-callback apm_dummy_callback} {-load_data_model:boolean} {-install_from_repository:boolean} {-data_model_files 0} {-package_path ""} {-mount_path ""} - spec_file_path + spec_file_path } { Registers a new package and/or version in the database, returning the version_id. If $callback is provided, periodically invokes this procedure with a single argument @@ -775,36 +775,36 @@ # Determine if we are upgrading or installing. set upgrade_from_version_name [apm_package_upgrade_from $package_key $version(name)] - + if {$upgrade_from_version_name ne "" && $upgrade_from_version_name eq $version_name} { # # nothing to do. # ns_log notice "apm_package_install package $package_key already installed in version $version_name" return [apm_version_id_from_package_key $package_key] } - - set upgrade_p [expr {$upgrade_from_version_name ne ""}] + set upgrade_p [expr {$upgrade_from_version_name ne ""}] + if {$upgrade_p} { set operations {Upgrading Upgraded} } else { set operations {Installing Installed} } - + apm_callback_and_log $callback "

    [lindex $operations 0] $version(package-name) $version(name)

    " if { [string match "[apm_workspace_install_dir]*" $package_path] } { # Package is being installed from the apm_workspace dir (expanded from .apm file) # Backup any existing (old) package in packages dir first set old_package_path [acs_package_root_dir $package_key] - if { [file exists $old_package_path] } { + if { [file exists $old_package_path] } { util::backup_file -file_path $old_package_path } - # Move the package into the packages dir + # Move the package into the packages dir file rename -- $package_path $::acs::rootdir/packages # We moved the spec file, so update its path @@ -830,7 +830,7 @@ set vendor $version(vendor) set vendor_uri $version(vendor.url) set split_path [split $spec_file_path /] - set relative_path [join [lreplace $split_path 0 [lsearch -exact $package_key $split_path]] /] + set relative_path [join [lreplace $split_path 0 [lsearch -exact $package_key $split_path]] /] # Register the package if it is not already registered. if { ![apm_package_registered_p $package_key] } { @@ -925,7 +925,7 @@ $version(embeds) $version(extends) $version(provides) $version(requires) $version_id apm_build_one_package_relationships $package_key apm_copy_inherited_params $package_key [concat $version(embeds) $version(extends)] - + # Install the parameters for the version. apm_package_install_parameters -callback $callback $version(parameters) $package_key } @@ -934,7 +934,7 @@ apm_package_install_owners -callback $callback $version(owners) $version_id apm_package_install_callbacks -callback $callback $version(callbacks) $version_id apm_build_subsite_packages_list - + apm_callback_and_log $callback "

    [lindex $operations 1] $version(package-name), version $version(name).

    " } on error {errmsg} { ns_log Error "apm_package_install: Error installing $version(package-name) version $version(name): $errmsg\n$::errorInfo" @@ -945,15 +945,15 @@

    - NOTE: If the error comes from a sql script you may try to source it manually. When you are done with that you should revisit the APM and try again but remember to leave the manually souced sql scipts unchecked on the previous page. + NOTE: If the error comes from a sql script you may try to source it manually. When you are done with that you should revisit the APM and try again but remember to leave the manually souced sql scipts unchecked on the previous page.

    }] return 0 } # Enable the package if { $enable_p } { - nsv_set apm_enabled_package $package_key 1 + nsv_set apm_enabled_package $package_key 1 apm_version_enable -callback $callback $version_id } @@ -970,7 +970,7 @@ set parent_id [site_node::get_node_id -url "/"] if { [catch { - db_transaction { + db_transaction { set node_id [site_node::new -name $priority_mount_path -parent_id $parent_id] } } error] } { @@ -999,7 +999,7 @@ set error_text "Package $version(package-name) could not be mounted at /$version(auto-mount) , there may already be a package mounted there, the error is: $error" ns_log Error "apm_package_install: $error_text \n\n$::errorInfo" apm_callback_and_log $callback "

    $error_text

    " - } + } } elseif { $package_type eq "apm_service" && $singleton_p == "t" } { # This is a singleton package. Instantiate it automatically, but don't mount. @@ -1009,7 +1009,7 @@ -package_key $package_key } - + if {[file exists $::acs::rootdir/packages/$package_key/install.xml]} { # # Run install.xml only for new installs @@ -1108,7 +1108,7 @@ ad_proc -private apm_package_deinstall { - {-callback apm_dummy_callback} + {-callback apm_dummy_callback} package_key } { @@ -1163,7 +1163,7 @@ # get the supposedly unique enabled version of this package set version_id [apm_version_id_from_package_key $package_key] - # Unmount all instances of this package with the Tcl API that + # Unmount all instances of this package with the Tcl API that # invokes before-unmount callbacks db_transaction { db_foreach all_package_instances { @@ -1177,7 +1177,7 @@ site_node::unmount -node_id $node_id } - # Delete the package instances with Tcl API that invokes + # Delete the package instances with Tcl API that invokes # before-uninstantiate callbacks db_foreach all_package_instances { select package_id @@ -1210,12 +1210,12 @@ db_source_sql_file -callback $callback "[acs_package_root_dir $package_key]/$path" apm_callback_and_log $callback "" } - } + } # Optionally remove the files from the filesystem if {$remove_files_p==1} { - if { [catch { - file delete -force -- [acs_package_root_dir $package_key] + if { [catch { + file delete -force -- [acs_package_root_dir $package_key] } error] } { apm_callback_and_log $callback "
  • Unable to delete [acs_package_root_dir $package_key]:$error" } @@ -1282,7 +1282,7 @@ lassign $item file_path file_type ns_log Debug "apm_package_install_data_model: Now processing $file_path of type $file_type" - if {$file_type eq "data_model_create" || + if {$file_type eq "data_model_create" || $file_type eq "data_model_upgrade" } { if { !$ul_p } { apm_callback_and_log $callback "