- Updated to OpenACS 5.9.1

acs-bootstrap-installer.info

@@ -9,18 +9,18 @@
     <implements-subsite-p>f</implements-subsite-p>
     <inherit-templates-p>t</inherit-templates-p>
     
-   <version name="5.9.0" url="http://openacs.org/repository/download/apm/acs-bootstrap-installer-5.9.0.apm">
+   <version name="5.9.1" url="http://openacs.org/repository/download/apm/acs-bootstrap-installer-5.9.1.apm">
         <owner url="mailto:dhogaza@pacifier.com">Don Baccus</owner>
         <summary>Bootstraps an OpenACS installation.</summary>
-        <release-date>2015-10-04</release-date>
+        <release-date>2017-08-06</release-date>
         <vendor url="http://openacs.org">OpenACS</vendor>
         <description format="text/html">This package bootstraps OpenACS. If the core packages have not yet been installed, it calls the installer which leads the user through the steps necessary to do so.  It also checks that the installation meets the requirements for a successful install of OpenACS.</description>
         <license>GPL</license>
         <maturity>3</maturity>
 
-        <provides url="acs-bootstrap-installer" version="5.9.0"/>
-        <requires url="acs-kernel" version="5.9.0"/>
-        <requires url="acs-templating" version="5.9.0"/>
+        <provides url="acs-bootstrap-installer" version="5.9.1"/>
+        <requires url="acs-kernel" version="5.9.1"/>
+
 
         <callbacks>
             <callback type="after-upgrade"  proc="apm_bootstrap_upgrade"/>

bootstrap.tcl

@@ -65,7 +65,7 @@ set errno [catch {
     # Used for ns_logs:
     set proc_name {Bootstrap}
 
-    # Load the special bootstrap tcl library.
+    # Load the special bootstrap Tcl library.
 
     set files [lsort [glob -nocomplain "$::acs::rootdir/packages/acs-bootstrap-installer/tcl/*-procs.tcl"]]
     if { [llength $files] == 0 } {
@@ -128,14 +128,23 @@ set errno [catch {
     apm_bootstrap_load_queries acs-tcl
     apm_bootstrap_load_queries acs-bootstrap-installer
 
-    # Is OpenACS installation complete? If not, source the installer and bail.
+    # Is OpenACS installation complete? If not, source the installer and bail out.
     if { ![ad_verify_install] } {
-	ns_log Notice "$proc_name: Installation is not complete - sourcing the installer."
+	ns_log warning "$proc_name: Installation is not complete - sourcing the installer."
 	source "$::acs::rootdir/packages/acs-bootstrap-installer/installer.tcl"
 	source "$::acs::rootdir/packages/acs-bootstrap-installer/installer-init.tcl"
 	return
     }
+    
+    #
+    # The installation is apparently ok, we can use the database. It
+    # should not be necessary to use the [ad_acs_kernel_id] redefine
+    # trick, but to use a plain variable in the ::acs namespace.
+    #
+    set ::acs::kernel_id [ad_acs_kernel_id_mem]
+    ns_log notice "bootstrap: setting ::acs::kernel_id to $::acs::kernel_id"
 
+    #
     # Load all parameters for enabled package instances.
     # ad_parameter_cache_all  
     
@@ -144,17 +153,7 @@ set errno [catch {
 
     # LARS: Load packages/acs-automated-testing/tcl/aa-test-procs.tcl
     ns_log Notice "Loading acs-automated-testing specially so other packages can define tests..."
-#    apm_bootstrap_load_libraries -procs acs-automated-testing
-
-    # Package libraries are now loaded in dependency order, rather than
-    # alphabetically.  This code is obsolete and has been commented out
-    # for 5.7.
-
-    #if {[info commands ::xotcl::Class] ne "" &&
-    #    [file isdirectory $::acs::rootdir/packages/xotcl-core]} {
-    #   apm_bootstrap_load_libraries -procs xotcl-core
-    #   apm_bootstrap_load_libraries -init xotcl-core
-    #}
+    # apm_bootstrap_load_libraries -procs acs-automated-testing
 
     # Build the list of subsite packages
     apm_build_subsite_packages_list
@@ -182,7 +181,7 @@ set errno [catch {
 }]
 
 if { $errno && $errno != 2 } {
-    # An error occured while bootstrapping. Handle it by registering a filter
+    # An error occurred while bootstrapping. Handle it by registering a filter
     # to display the error message, rather than leaving the site administrator
     # to guess what broke.
 

db-init-checks-oracle.tcl

@@ -15,7 +15,7 @@ proc db_bootstrap_checks { errors error_p } {
             append my_errors "(db_bootstrap_checks) Internal error accessing pool \"$pool\".<br>"
             set my_error_p 1
         } else { # DRB: The aD code didn't deallocate the database handle if either of the following
-            # errors occured.  Boo hiss...
+            # errors occurred.  Boo hiss...
             if { [catch { ns_ora 1row $db "select sysdate from dual" }] ||
                  [catch { ns_ora exec_plsql_bind $db { begin :1 := 37*73; end; } 1 "" }] } {
                 append my_errors "Database pool \"$pool\" has been configured with an old version of the Oracle driver.  You'll need version 2.3 or later.<br>"
@@ -69,7 +69,7 @@ proc db_helper_checks { errors error_p } {
 
     # Oracle should provide ctxhx
     global env
-    # How the hell we'd get this far without ORACLE_HOME is beyond me, but they wanna
+    # How the hell we'd get this far without ORACLE_HOME is beyond me, but they want to
     # check, so let them check!
     if {![info exists env(ORACLE_HOME)]} {
         append my_errors "<li><p>

db-init-checks-postgresql.tcl

@@ -36,8 +36,8 @@ proc db_bootstrap_checks { errors error_p } {
     }
 
     if { $version < 9.0 } {
-        append my_errors "<li>WARNING: Your installed version of Postgres is too old.  Please install PostgreSQL 9.0 or later.\n"
-#        set my_error_p 1
+        append my_errors "<li>Your installed version of Postgres is too old.  Please install PostgreSQL 9.0 or later.\n"
+        set my_error_p 1
     }
 
     if { [catch { ns_pg_bind 1row $db "select count(*) from pg_class" }] } {

installer.tcl

@@ -319,6 +319,17 @@ proc install_admin_widget {} {
 
 }
 
+proc install_back_button_widget {} {    
+    return [subst {Please <a id="install-back-button" href="#">try again</a>.
+    <script type='text/javascript' nonce='[security::csp::nonce]'>
+     var e = document.getElementById('install-back-button');
+     e.addEventListener('click', function (event) {
+        event.preventDefault();
+        history.back();
+     }, false);
+    </script>}]
+}
+
 proc install_redefine_ad_conn {} {
 
     # Peter Marklund
@@ -340,12 +351,7 @@ ad_proc -public ad_windows_p {} {
     Returns 1 if the ACS is running under Windows.
     Note,  this procedure is a best guess, not sure of a better way of determining:
 } {
-    set thisplatform [ns_info platform]
-    if {$thisplatform eq "win32"} {
-        return 1
-    } else {
-        return 0
-    }
+    return [expr {[ns_info platform] in {win32 win64}}]
 }
 
 ad_proc -private install_load_errors_formatted {errorVarName} {
@@ -408,6 +414,7 @@ ad_proc -private install_do_data_model_install {} {
     Done installing the OpenACS kernel data model.<p>
 
     "
+    ns_write "\n<script>window.scrollTo(0,document.body.scrollHeight);</script>\n"
 
     # Some APM procedures use util_memoize, so initialize the cache 
     # before starting APM install
@@ -429,7 +436,8 @@ ad_proc -private install_do_data_model_install {} {
     # Preload all the .info files so the next page is snappy.
     apm_dependency_check -initial_install [apm_scan_packages -new [file join $::acs::rootdir packages]]
 
-    ns_write "Done loading package .info files<p>"    
+    ns_write "Done loading package .info files<p>"
+    ns_write "\n<script>window.scrollTo(0,document.body.scrollHeight);</script>\n"
 }
 
 ad_proc -private install_do_packages_install {} {
@@ -445,6 +453,8 @@ ad_proc -private install_do_packages_install {} {
             } -default 0]
             if {$kernel_id > 0} {
                 proc ad_acs_kernel_id {} "return $kernel_id"
+                ns_log notice "installer: setting ::acs::kernel_id to $kernel_id"
+                set ::acs::kernel_id $kernel_id
             }
             return $kernel_id
         } else {
@@ -480,12 +490,20 @@ ad_proc -private install_do_packages_install {} {
         ns_write "<p><b><i>At least one core package has an unsatisifed dependency.\
               No packages have been installed missing: [lindex $dependency_results 2]. \
               Here's what the APM has computed:</i></b>"
-
+        
         ns_write "\n<ul>"
+        set deps ""
         foreach dep $pkg_list {
             lassign $dep _name _path _a _b _pkg _deps _flag _msg
             ns_write "<li>[lindex $_pkg 0]: $_msg</li>"
+            append deps "[lindex $_pkg 0]: $_msg\n"
         }
+        ns_write "\n<script>window.scrollTo(0,document.body.scrollHeight);</script>\n"
+        
+        ns_log Error "At least one core package has an unsatisifed dependency.\
+              No packages have been installed missing: [lindex $dependency_results 2]. \
+              Here's what the APM has computed:\n$deps"
+
         return
     }
 
@@ -514,6 +532,7 @@ ad_proc -private install_do_packages_install {} {
     }
 
     ns_write "All Packages Installed."
+    ns_write "\n<script>window.scrollTo(0,document.body.scrollHeight);</script>\n"
 }
 
 # Register the install handler.

installer/index.tcl

@@ -177,8 +177,9 @@ After adding support for the fancy ADP parser, please restart your web server.
 
 set stacksize [ns_config "ns/threads" StackSize]
 
-if { ![string is integer $stacksize] ||
-     $stacksize < [expr {$acs_application(min_stack_size) * 1024}] } {
+if { ![string is integer $stacksize]
+     || $stacksize < $acs_application(min_stack_size) * 1024
+ } {
     append errors "<li><p><strong>The configured AOLserver Stacksize is too small, missing, or a non-integer value.
 $acs_application(pretty_name) requires a StackSize parameter of at least
 ${acs_application(min_stack_size)}K.
@@ -225,7 +226,7 @@ chmod -R ug+rw $::acs::rootdir/packages
 
 db_helper_checks errors error_p
 
-# Now that we know that the database and aolserver are set up
+# Now that we know that the database and AOLserver are set up
 # correctly, let's check out the actual db.
 if {$error_p} {
     append body [subst {<p>
@@ -263,9 +264,7 @@ if { ![db_table_exists apm_packages] } {
         set system_url "http://yourdomain.com"
     }
 
-    set email_input_widget [install_input_widget \
-                                -extra_attributes "onChange=\"updateSystemEmails()\"" \
-                                email]
+    set email_input_widget [install_input_widget -extra_attributes {id="email-addr"} email]
     append body "
 
 <h2>System Configuration</h2>
@@ -274,47 +273,35 @@ We'll need to create a site-wide administrator for your server (like the root
 user in UNIX). Please type in the email address, first and last name, and password
 for this user.
 
-<script type=\"text/javascript\">
-function updateSystemEmails() {
-    var form = document.forms\[0\];
-    
-    form.system_owner.value = form.email.value;
-    form.admin_owner.value = form.email.value;
-    form.host_administrator.value = form.email.value;
-    form.outgoing_sender.value = form.email.value;
-    form.new_registrations.value = form.email.value;
-}
-</script>
-
-<form action=\"installer/install\" method=\"POST\">
+<form action='installer/install' method='POST'>
 
 <table>
 <tr>
-  <th span=3>System Administrator</th>
+  <th span='3'>System Administrator</th>
 </tr>
 
 <tr>
-  <th align=right>Email:</th>
+  <th align='right'>Email:</th>
 <td>$email_input_widget</td>
 </tr>
 <tr>
-  <th align=right>Username:</th>
+  <th align='right'>Username:</th>
   <td>[install_input_widget username]</td>
 </tr>
 <tr>
-  <th align=right>First Name:</th>
+  <th align='right'>First Name:</th>
   <td>[install_input_widget first_names]</td>
 </tr>
 <tr>
-  <th align=right>Last Name:</th>
+  <th align='right'>Last Name:</th>
   <td>[install_input_widget last_name]</td>
 </tr>
 <tr>
-  <th align=right>Password:</th>
+  <th align='right'>Password:</th>
   <td>[install_input_widget -size 12 -type password password]</td>
 </tr>
 <tr>
-  <th align=right>Password (again):</th>
+  <th align='right'>Password (again):</th>
   <td>[install_input_widget -size 12 -type password password_confirmation]</td>
 </tr>
 
@@ -323,50 +310,50 @@ function updateSystemEmails() {
 </tr>
 
 <tr>
-  <th align=right>System URL:</th>
+  <th align='right'>System URL:</th>
   <td>[install_input_widget -value $system_url system_url]<br>
 The canonical URL of your system as visible from the outside world<br>
 Usually it should include the port if your server is not on port 80<br><br>
 </tr>
 <tr>
-  <th align=right>System Name:</th>
+  <th align='right'>System Name:</th>
   <td>[install_input_widget -value "yourdomain Network" system_name]<br>
 The name of your system.<br><br>
 </tr>
 <tr>
-  <th align=right>Publisher Name:</th>
+  <th align='right'>Publisher Name:</th>
   <td>[install_input_widget -value "Yourdomain Network, Inc." publisher_name]<br>
 The legal name of the person or corporate entity responsible for the site.<br><br>
 </tr>
 <tr>
-  <th align=right>System Owner:</th>
+  <th align='right'>System Owner:</th>
   <td>[install_input_widget system_owner]<br>
 The email address signed at the bottom of user-visible pages.<br><br>
 </tr>
 <tr>
-  <th align=right>Admin Owner:</th>
+  <th align='right'>Admin Owner:</th>
   <td>[install_input_widget admin_owner]<br>
 The email address signed on administrative pages.<br><br>
 </tr>
 <tr>
-  <th align=right>Host Administrator:</th>
+  <th align='right'>Host Administrator:</th>
   <td>[install_input_widget host_administrator]<br>
 A person whom people can contact if they experience technical problems.<br><br>
 </tr>
 <tr>
-  <th align=right>Outgoing Email Sender:</th>
+  <th align='right'>Outgoing Email Sender:</th>
   <td>[install_input_widget outgoing_sender]<br>
 The email address that will sign outgoing alerts.
 </tr>
 <tr>
-  <th align=right>New Registration Email:</th>
+  <th align='right'>New Registration Email:</th>
   <td>[install_input_widget new_registrations]<br>
 The email address to send New registration notifications.<br><br>
 </tr>
 </table>
 
 <center>
-<input type=submit value=\"Start installation ->\">
+<input type='submit' value='Start installation ->'>
 </center>
 </form>
 
@@ -377,6 +364,21 @@ The email address to send New registration notifications.<br><br>
   This is particularly useful if you're authenticating against other services, such as LDAP or the 
   local operating system, which may not use email as the basis of authentication.
 </p>
+
+<script type='text/javascript'>
+function updateSystemEmails() {
+    var form = document.forms\[0\];
+    
+    form.system_owner.value = form.email.value;
+    form.admin_owner.value = form.email.value;
+    form.host_administrator.value = form.email.value;
+    form.outgoing_sender.value = form.email.value;
+    form.new_registrations.value = form.email.value;
+}
+var elem = document.getElementById('email-addr');
+elem.addEventListener('change', function (event) {updateSystemEmails();});
+</script>
+
     "
 } else {
     # OK, apm_packages is installed - let's check out some other stuff too:

installer/install.tcl

@@ -20,9 +20,10 @@ foreach var_name {system_owner admin_owner host_administrator outgoing_sender ne
 #############
 
 if {$password ne $password_confirmation  } {
-    install_return 200 "Passwords Don't Match" "
-The passwords you've entered don't match. Please <a href=\"javascript:history.back()\">try again</a>.
-"
+    install_return 200 "Passwords Don't Match" [subst {
+The passwords you've entered don't match. 
+[install_back_button_widget]
+    }]
     return
 }
 
@@ -99,15 +100,11 @@ if { ![db_string user_exists {
 
     if { !$user_id } {
 
-	install_return 200 "Unable to Create Administrator" "
-    
+	install_return 200 "Unable to Create Administrator" [subst {
 Unable to create the site-wide administrator:
-   
 <blockquote><pre>[ns_quotehtml $::errorInfo]</pre></blockquote>
-    
-Please <a href=\"javascript:history.back()\">try again</a>.
-    
-"
+[install_back_button_widget]            
+}
         return
     }
 

installer/tcl/0-acs-init.tcl

@@ -20,7 +20,7 @@ namespace eval acs {
     # represented by a list consisting of the internal name, driver name, and
     # "pretty name" (used by the APM to list the available database engines that 
     # one's package can choose to support).  The driver name and "pretty name" happen
-    # to be the same for Postgres and Oracle but let's not depend on that being true
+    # to be the same for PostgreSQL and Oracle but let's not depend on that being true
     # in all cases...
     #
 
@@ -63,7 +63,7 @@ if { [file isfile $bootstrap_file] } {
 		lassign [split $version .] major minor point
 		if {$major == 0 
 		    && ( $minor < 7 || ($minor == 7 && $point < 8))} { 
-		    ns_log Error "0-acs-init.tcl: please use tdom version 0.7.8 or greater (you have version $version)"
+		    ns_log Error "0-acs-init.tcl: please use tDOM version 0.7.8 or greater (you have version $version)"
 		}
 	    }
 	}

installer/tcl/zz-postload.tcl

@@ -12,7 +12,7 @@ foreach file [glob -nocomplain ${::acs::tcllib}/*.tcl.postload] {
 ns_log "Notice" "Done."
 
 # This should probably be moved to the end of bootstrap.tcl once all files are
-# weeded out of the tcl directory.
+# weeded out of the Tcl directory.
 ns_log "Notice" "Executing initialization code blocks..."
 foreach init_item [nsv_get ad_after_server_initialization .] {
     array set init $init_item
@@ -36,7 +36,7 @@ foreach init_item [nsv_get ad_after_server_initialization .] {
 proc __is_xql {arg} { 
     return [expr {[file isdirectory $arg] || [file extension $arg] eq ".xql"}]}
 
-# We need to load query files for the top-level stuff in www and tcl
+# We need to load query files for the top-level stuff in www and Tcl
 # dirs is the list of directories to walk for xql files.  Packages .xql
 # files are parsed elsewhere in the bootstrap process.
 

installer/www/blank-master.adp

@@ -5,10 +5,10 @@
 
 <multiple name="meta">    <meta<if @meta.http_equiv@ not nil> http-equiv="@meta.http_equiv;literal@"</if><if @meta.name@ not nil> name="@meta.name;noquote@"</if><if @meta.scheme@ not nil> scheme="@meta.scheme;noquote@"</if><if @meta.lang@ not nil and @meta.lang;literal@ ne @doc.lang;literal@> lang="@meta.lang;literal@"</if> content="@meta.content@">
 </multiple>
-<multiple name="link">    <link rel="@link.rel;literal@" href="@link.href@"<if @link.lang@ not nil and @link.lang;literal@ ne @doc.lang;literal@> lang="@link.lang;literal@"</if><if @link.title@ not nil> title="@link.title@"</if><if @link.type@ not nil> type="@link.type;literal@"</if><if @link.media@ not nil> media="@link.media;literal@"</if>>
+<multiple name="link">    <link rel="@link.rel;literal@" href="@link.href@"<if @link.lang@ not nil and @link.lang;literal@ ne @doc.lang;literal@> lang="@link.lang;literal@"</if><if @link.title@ not nil> title="@link.title@"</if><if @link.type@ not nil> type="@link.type;literal@"</if><if @link.media@ not nil> media="@link.media;literal@"</if><if @link.integrity@ not nil> integrity="@link.integrity;literal@"</if><if @link.crossorigin@ not nil> crossorigin="@link.crossorigin;literal@"</if>>
 </multiple>
 
-<multiple name="___style"> <style type="@___style.type;literal@" <if @___style.lang@ not nil and @___style.lang;literal@ ne @doc.lang;literal@> lang="@___style.lang;literal@"</if><if @___style.title@ not nil> title="@___style.title@"</if><if @___style.media@ not nil> media="@___style.media;literal@"</if>>@___style.style;literal@
+<multiple name="___style"> <style type="@___style.type;literal@" <if @___style.lang@ not nil and @___style.lang;literal@ ne @doc.lang;literal@> lang="@___style.lang;literal@"</if><if @___style.title@ not nil> title="@___style.title@"</if><if @___style.media@ not nil> media="@___style.media;literal@"</if><if @::__csp_nonce@ not nil> nonce="@::__csp_nonce;literal@"</if>>@___style.style;literal@
 </style>
 </multiple>
 
@@ -17,22 +17,22 @@
    enforce the order, it is put here.
 </comment>
 <if @::acs_blank_master__htmlareas@ defined and @::xinha_dir@ defined and @::xinha_lang@ defined>
-<script type="text/javascript">
+<script type="text/javascript"<if @::__csp_nonce@ not nil> nonce="@::__csp_nonce;literal@"</if>>
 _editor_url = "@::xinha_dir;literal@"; 
 _editor_lang = "@::xinha_lang;literal@";
 </script>
 </if>
 
-<multiple name="headscript">   <script type="@headscript.type;literal@"<if @headscript.src@ not nil> src="@headscript.src;literal@"</if><if @headscript.charset@ not nil> charset="@headscript.charset;literal@"</if><if @headscript.defer@ not nil> defer="@headscript.defer;literal@"</if><if @headscript.async@ not nil> async="@headscript.async;literal@"</if>><if @headscript.content@ not nil>@headscript.content;noquote@</if></script>
+<multiple name="headscript">   <script type="@headscript.type;literal@"<if @headscript.src@ not nil> src="@headscript.src;literal@"</if><if @headscript.charset@ not nil> charset="@headscript.charset;literal@"</if><if @headscript.defer@ not nil> defer="@headscript.defer;literal@"</if><if @headscript.async@ not nil> async="@headscript.async;literal@"</if><if @headscript.integrity@ not nil> integrity="@headscript.integrity;literal@"</if><if @headscript.crossorigin@ not nil> crossorigin="@headscript.crossorigin;literal@"</if><if @::__csp_nonce@ not nil> nonce="@::__csp_nonce;literal@"</if>><if @headscript.content@ not nil>@headscript.content;noquote@</if></script>
 </multiple>
 
 <if @head@ not nil>@head;literal@</if>
 </head>
-<body<if @body.class@ not nil> class="@body.class;literal@"</if><if @body.id@ not nil> id="@body.id;literal@"</if><if @event_handlers@ not nil>@event_handlers;literal@</if>>
+<body<if @body.class@ not nil> class="@body.class;literal@"</if><if @body.id@ not nil> id="@body.id;literal@"</if>>
   @header;literal@
 <slave>
   @footer;literal@
-<multiple name="body_script">    <script type="@body_script.type;literal@"<if @body_script.src@ not nil> src="@body_script.src;literal@"</if><if @body_script.charset@ not nil> charset="@body_script.charset;literal@"</if><if @body_script.defer@ not nil> defer="@body_script.defer;literal@"</if><if @body_script.async@ not nil> async="@body_script.async;literal@"</if>><if @body_script.content@ not nil>@body_script.content;literal@</if></script>
+<multiple name="body_script">    <script type="@body_script.type;literal@"<if @body_script.src@ not nil> src="@body_script.src;literal@"</if><if @body_script.charset@ not nil> charset="@body_script.charset;literal@"</if><if @body_script.defer@ not nil> defer="@body_script.defer;literal@"</if><if @body_script.async@ not nil> async="@body_script.async;literal@"</if><if @body_script.integrity@ not nil> integrity="@body_script.integrity;literal@"</if><if @body_script.crossorigin@ not nil> crossorigin="@body_script.crossorigin;literal@"</if><if @::__csp_nonce@ not nil> nonce="@::__csp_nonce;literal@"</if>><if @body_script.content@ not nil>@body_script.content;literal@</if></script>
 </multiple>
 
 </body>

tcl/00-proc-procs.tcl

@@ -49,9 +49,41 @@ proc ad_make_relative_path { path } {
 
 proc ad_get_tcl_call_stack { { level -2 }} {
     set stack ""
+    #
+    # keep the previous state of ::errorInfo
+    #
+    set errorInfo $::errorInfo
+    
     for { set x [expr {[info level] + $level}] } { $x > 0 } { incr x -1 } {
-	append stack "    called from [info level $x]\n"
+        set info [info level $x]
+        regsub -all \n $info {\\n} info
+        #
+        # In case, we have an nsf frame, add information about the
+        # current object and the current class to the debug output.
+        #
+        if {![catch {uplevel #$x ::nsf::current} obj]
+            && ![catch {uplevel #$x [list ::nsf::current class]} class]
+        } {
+            set objInfo [list $obj $class]
+            set info "{$objInfo} $info"
+        }
+        #
+        # Don't produce too long lines
+        #
+        if {[string length $info]>200} {
+            set arglist ""
+            foreach arg $info {
+                if {[string length $arg]>40} {set arg [string range $arg 0 40]...}
+                lappend arglist $arg
+            }
+            set info $arglist
+        }
+        append stack "    called from $info\n"
     }
+    #
+    # restore previous state of ::errorInfo
+    #
+    set ::errorInfo $errorInfo
     return $stack
 }
 
@@ -152,6 +184,11 @@ proc ad_proc args {
     if { !$public_p && !$private_p } {
         set public_p 1
     }
+    if {$public_p} {
+        set protection public
+    } else {
+        set protection private
+    }
 
     if { $warn_p && !$deprecated_p } {
         return -code error "Switch -warn can be provided to ad_proc only if -deprecated is also provided"
@@ -266,6 +303,7 @@ proc ad_proc args {
     set arg_list [lindex $args $i+1]
     if { $n_args_remaining == 3 } {
         # No doc string provided.
+        #ns_log notice "missing doc string for ad_proc $proc_name ([info script])"
         array set doc_elements [list]
 	set doc_elements(main) ""
     } else {
@@ -402,7 +440,8 @@ proc ad_proc args {
         }
     }
 
-    foreach element { public_p private_p deprecated_p warn_p varargs_p arg_list switches positionals } {
+    set protection 
+    foreach element { protection deprecated_p warn_p varargs_p arg_list switches positionals } {
         set doc_elements($element) [set $element]
     }
     foreach element { default_values flags } {
@@ -470,7 +509,7 @@ proc ad_proc args {
 
     } elseif { $callback eq "" && [llength $switches] == 0 } {
 	#
-	# Nothing special is used in the argument definiton, create a
+	# Nothing special is used in the argument definition, create a
 	# plain proc
 	#
         uplevel [::list proc $proc_name_as_passed $arg_list "${log_code}$code_block"]
@@ -664,7 +703,7 @@ ad_proc -public ::foobar::new {
 	\@author Roberto Mello <rmello at fslc.usu.edu>
 	\@creation-date 2002-01-21
 	
-	\@param oacs_user If this user is already an openacs user. oacs_user_p will be defined.
+	\@param oacs_user If this user is already an OpenACS user. oacs_user_p will be defined.
 	\@param shazam Magical incantation that calls Captain Marvel. Required parameter.
 	\@param user_id The id for the user to process. Optional with default "" 
 	                (api-browser will show the default automatically)
@@ -674,7 +713,7 @@ ad_proc -public ::foobar::new {
 	}
 
 	if { $oacs_user_p } {
-		# Do something if this is an openacs user
+		# Do something if this is an OpenACS user
 	}
 }
     </pre>

tcl/10-utilities-procs.tcl

@@ -9,14 +9,20 @@ ad_library {
 
 ad_proc -public ad_find_all_files {
     {-include_dirs 0}
+    {-include_bak_dirs 0}
     {-max_depth 10}
     {-check_file_func ""}
     path
 } {
 
-    Returns a list of full paths to all files under $path in the directory tree
-    (descending the tree to a depth of up to $max_depth).  Clients should not 
-    depend on the order of files returned.
+    Returns a list of full paths to all files under $path in the
+    directory tree (descending the tree to a depth of up to
+    $max_depth).  Clients should not depend on the order of files
+    returned.
+
+    Per default, the contents of .bak directories (as produced
+    e.g. via "install from repository" are not included. To include
+    these, add the flag "-include_bak_dirs 1" to the invocation.
 
 } {
     # Use the examined_files array to track files that we've examined.
@@ -50,9 +56,12 @@ ad_proc -public ad_find_all_files {
 		    if { [file isfile $file] } {
 			lappend files $file
 		    } elseif { [file isdirectory $file] } {
-			if { $include_dirs == 1 } {
-			    lappend files $file
-			}
+                        if { $include_bak_dirs && [string match "*.bak" $file] } {
+                            continue
+                        }
+                        if { $include_dirs == 1 } {
+                            lappend files $file
+                        }
 			lappend new_files_to_examine {*}[glob -nocomplain "$file/*"]
 		    }
 		}

tcl/20-db-bootstrap-procs.tcl

@@ -29,7 +29,7 @@ ad_proc -private db_pool_to_dbn_init {} {
 
     @see db_driverkey
 } {
-    foreach dbn [nsv_array names {db_available_pools}] {
+    foreach dbn [nsv_array names db_available_pools] {
         foreach pool [db_available_pools $dbn] {
             nsv_set db_pool_to_dbn $pool $dbn
         }
@@ -232,14 +232,19 @@ ad_proc db_bootstrap_set_db_type { errors } {
             ns_db releasehandle $db
             if { $this_suffix eq "" } {
                 ns_log Notice "$proc_name: couldn't determine RDBMS type of database pool \"$pool\"."
-                lappend bad_pools "<li>OpenACS could not determine the RDBMS type associated with
-    pool \"$pool\"."
+                lappend bad_pools "<li>OpenACS could not determine the RDBMS type associated with pool \"$pool\"."
                 set long_error 1
             } elseif { [nsv_get ad_database_type .] eq "" } {
                 nsv_set ad_database_type . $this_suffix
+                #
+                # For the time being, keep the info in the nsv for
+                # backwards compatibility and and a version in a
+                # per-thead (namespaced) variable
+                #
+                set ::acs::database_type $this_suffix
+                
             } elseif { ![string match $this_suffix [nsv_get ad_database_type .]] } {
-                ns_log Notice "$proc_name: Database pool \"$pool\" type \"$this_suffix\" differs from
-    \"[nsv_get ad_database_type .]\"."
+                ns_log Notice "$proc_name: Database pool \"$pool\" type \"$this_suffix\" differs from \"[nsv_get ad_database_type .]\"."
                 lappend bad_pools "<li>Database pool \"$pool\" is of type \"$this_suffix\".  The
     first database pool available to OpenACS was of type \"[nsv_get ad_database_type .]\".  All database
     pools must be configured to use the same RDMBS engine, user and database."

tcl/30-apm-load-procs.tcl

@@ -410,7 +410,7 @@ ad_proc -private apm_bootstrap_load_libraries {
     package_key
     {errorVarName ""}
 } {
-    Scan all the files in the tcl dir of the package and load those asked for by the init
+    Scan all the files in the "tcl" dir of the package and load those asked for by the init
     and procs flags.
 
     This proc is an analog of apm_load_libraries.  In addition though
@@ -491,12 +491,14 @@ ad_proc -private apm_load_install_xml_file {} {
 
     @author Peter Marklund
 } {
+    set fn [apm_install_xml_file_path]
     # Abort if there is no install.xml file
-    if { ![file exists [apm_install_xml_file_path]] } {
+    if { ![file exists $fn] } {
         return ""
     }
 
-    set file [open [apm_install_xml_file_path]]
+    #ns_log notice "==== LOADING xml file: $fn"
+    set file [open $fn]
     set root_node [xml_doc_get_first_node [xml_parse -persist [read $file]]]
     close $file
 
@@ -607,11 +609,20 @@ ad_proc apm_bootstrap_upgrade {
 } {
     set source $::acs::rootdir/packages/acs-bootstrap-installer/installer/tcl
     foreach file [glob -nocomplain $source/*tcl] {
-        file copy -force $file $::acs::rootdir/tcl
+        file copy -force -- $file $::acs::rootdir/tcl/
+        #
+        # It would be good to allow changes in the setup here, but for
+        # that, e.g. 0-acs-tcl has to be split up into two parts: (a)
+        # setup of variables, and (b) sourcing everything.
+        #
+        # source $::acs::rootdir/tcl/[file tail $file]
     }
     set source $::acs::rootdir/packages/acs-bootstrap-installer/installer/www
     foreach file [glob -nocomplain $source/*tcl $source/*adp] {
-        file copy -force $file $::acs::rootdir/www
+        file copy -force -- $file $::acs::rootdir/www/
+    }
+    foreach file [glob -nocomplain $source/SYSTEM/*tcl] {
+        file copy -force -- $file $::acs::rootdir/www/SYSTEM/
     }
 }
 

tcl/40-db-query-dispatcher-procs.tcl

@@ -293,7 +293,7 @@ ad_proc -public db_qd_get_fullname {local_name {added_stack_num 1}} {
         # added case for handling .vuh files which are sourced from 
         # rp_handle_tcl_request.  Otherwise, QD was forming fullquery path 
         # with the assumption that the query resided in the 
-        # rp_handle_tcl_request proc itself. (Openacs - DanW)
+        # rp_handle_tcl_request proc itself. (OpenACS - DanW)
 
         switch $proc_name {
 
@@ -356,7 +356,7 @@ ad_proc -public db_qd_get_fullname {local_name {added_stack_num 1}} {
         # check to see if a package proc is being called without 
         # namespace qualification.  If so, add the package qualification to the
         # proc_name, so that the correct query can be looked up. 
-        # (Openacs - DanW)
+        # (OpenACS - DanW)
 
         set calling_namespace [string range [uplevel [expr {1 + $added_stack_num}] {namespace current}] 2 end]
         # db_qd_log QDDebug "calling namespace = $calling_namespace"
@@ -705,18 +705,8 @@ ad_proc -private db_qd_internal_parse_one_query {parsing_state} {
 } { 
     
     # Find the index that we're looking at
-    set index [lindex $parsing_state 0]
+    lassign $parsing_state index node_list parsed_doc default_rdbms file_path
     
-    # Find the list of nodes
-    set node_list [lindex $parsing_state 1]
-
-    # Parsed Doc Pointer
-    set parsed_doc [lindex $parsing_state 2]
-
-    # Default RDBMS
-    set default_rdbms [lindex $parsing_state 3]
-    set file_path [lindex $parsing_state 4]
-
     # BASE CASE
     if {[llength $node_list] <= $index} {
 	# Clean up
@@ -736,7 +726,7 @@ ad_proc -private db_qd_internal_parse_one_query {parsing_state} {
 
     # Update the parsing state so we know
     # what to parse next 
-    set parsing_state [list $index $node_list [lindex $parsing_state 2] $default_rdbms $file_path]
+    set parsing_state [list $index $node_list $parsed_doc $default_rdbms $file_path]
 
     # Parse the actual query from XML
     set one_query [db_qd_internal_parse_one_query_from_xml_node $one_query_xml $default_rdbms $file_path]
@@ -838,6 +828,8 @@ ad_proc -private db_qd_make_absolute_path {relative_root suffix} {
 ## Extra Utilities to Massage the system and Rub it in all the right ways
 ##
 ad_proc -private db_qd_internal_prepare_queryfile_content {file_content} {
+    Prepare raw .xql-file content form xml-parsing via quoting
+} {
     
     set new_file_content ""