Commit 2319730d authored by Frank Bergmann's avatar Frank Bergmann

Initial Import

parents
<?xml version="1.0"?>
<!-- Generated by the OpenACS Package Manager -->
<package key="acs-bootstrap-installer" url="http://openacs.org/repository/apm/packages/acs-bootstrap-installer" type="apm_service">
<package-name>Bootstrap Installer</package-name>
<pretty-plural>Bootstrap Installers</pretty-plural>
<initial-install-p>t</initial-install-p>
<singleton-p>t</singleton-p>
<version name="5.1.5" url="http://openacs.org/repository/download/apm/acs-bootstrap-installer-5.1.5.apm">
<owner url="mailto:dhogaza@pacifier.com">Don Baccus</owner>
<summary>Bootstraps an OpenACS installation.</summary>
<release-date>2004-02-28</release-date>
<maturity>3</maturity>
<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>
<provides url="acs-bootstrap-installer" version="5.1.4"/>
<requires url="acs-kernel" version="5.0.0"/>
<callbacks>
</callbacks>
<parameters>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="post_installation_message" default="" description="If not blank, overrides the default post-installation message" section_name="installation"/>
</parameters>
</version>
</package>
# /packages/acs-tcl/bootstrap/bootstrap.tcl
#
# Code to bootstrap OpenACS, invoked by /tcl/0-acs-init.tcl.
#
# @creation-date 12 May 2000
# @author Jon Salz [jsalz@arsdigita.com]
# @cvs-id $Id$
# Remember the length of the error log file (so we can easily seek back to this
# point later). This is used in /www/admin/monitoring/startup-log.tcl to show
# the segment of the error log corresponding to server initialization (between
# "AOLserver/xxx starting" and "AOLserver/xxx running").
catch { nsv_set acs_properties initial_error_log_length [file size [ns_info log]] }
# Initialize proc_doc NSV arrays.
nsv_set proc_source_file . ""
# Initialize ad_after_server_initialization.
nsv_set ad_after_server_initialization . ""
###
#
# Bootstrapping code.
#
###
# A helper procedure called if a fatal error occurs.
proc bootstrap_fatal_error { message { throw_error_p 1 } } {
# First of all, redefine the "rp_invoke_filter" and "rp_invoke_procs"
# routines to do nothing, to circumvent the request processor.
proc rp_invoke_filter { conn arg why } { return "filter_ok" }
proc rp_invoke_procs { conn arg why } {}
set proc_name {Bootstrap}
global errorInfo
# Save the error message.
nsv_set bootstrap_fatal_error . "$message<blockquote><pre>[ns_quotehtml $errorInfo]</pre></blockquote>"
# Log the error message.
ns_log Error "$proc_name: Server startup failed: $message\n$errorInfo"
# Define a filter procedure which displays the appropriate error message.
proc bootstrap_write_error { conn arg why } {
ns_returnerror 503 "Server startup failed: [nsv_get bootstrap_fatal_error .]"
return "filter_return"
}
# Register the filter on GET/POST/HEAD * to return this message.
ns_register_filter preauth GET * bootstrap_write_error
ns_register_filter preauth POST * bootstrap_write_error
ns_register_filter preauth HEAD * bootstrap_write_error
if { $throw_error_p } {
return -code error -errorcode bootstrap_fatal_error "Bootstrap fatal error"
}
}
set errno [catch {
# Used for ns_logs:
set proc_name {Bootstrap}
# Load the special bootstrap tcl library.
set files [glob -nocomplain "$root_directory/packages/acs-bootstrap-installer/tcl/*-procs.tcl"]
if { [llength $files] == 0 } {
error "Unable to locate $root_directory/packages/acs-bootstrap-installer/tcl/*-procs.tcl."
}
foreach file [lsort $files] {
ns_log Notice "$proc_name: sourcing $file"
source $file
}
db_bootstrap_set_db_type database_problem
#####
#
# Perform some checks to make sure that (a) a recent version of the Oracle or PG driver
# is installed and (b) the OpenACS data model is properly loaded.
#
#####
# DRB: perform RDBMS-specific sanity checks if the user has survived the database
# gauntlet thus far.
if { ![info exists database_problem] } {
set db_fn "$root_directory/packages/acs-bootstrap-installer/db-init-checks-[nsv_get ad_database_type .].tcl"
if { ![file isfile $db_fn] } {
set database_problem "\"$db_fn\" does not exist."
} else {
source $db_fn
}
db_bootstrap_checks database_problem error_p
}
ns_log Notice "$proc_name: Loading acs-tcl"
apm_bootstrap_load_libraries -procs acs-tcl
if { [info exists database_problem] } {
# Yikes - database problems.
ns_log Error "$proc_name: $database_problem"
# Check if the admin enabled the site-failure message, display
# it if enabled.
if { [file exists "$root_directory/www/global/site-failure.html"] } {
ns_log Notice "$proc_name: database problem found; enabling www/global/site-failure.html. Rename this html page if you want to run the installer instead."
source "$root_directory/packages/acs-bootstrap-installer/site-failure-message.tcl"
return
}
# Remember what the problem is, and run the installer.
nsv_set acs_properties database_problem $database_problem
ns_log Notice "$proc_name: database problem found; Sourcing the installer."
source "$root_directory/packages/acs-bootstrap-installer/installer.tcl"
source "$root_directory/packages/acs-bootstrap-installer/installer-init.tcl"
return
}
# Here we need to at least load up queries for the acs-tcl and
# acs-bootstrap-installer packages (ben)
apm_bootstrap_load_queries acs-tcl
apm_bootstrap_load_queries acs-bootstrap-installer
# Is OpenACS installation complete? If not, source the installer and bail.
if { ![ad_verify_install] } {
ns_log Notice "$proc_name: Installation is not complete - sourcing the installer."
source "$root_directory/packages/acs-bootstrap-installer/installer.tcl"
source "$root_directory/packages/acs-bootstrap-installer/installer-init.tcl"
return
}
# Load all parameters for enabled package instances.
# ad_parameter_cache_all
# Load the Tcl package init files.
apm_bootstrap_load_libraries -init acs-tcl
# 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
# Load libraries, queries etc. for remaining packages
apm_load_packages
# The acs-tcl package is a special case. Its Tcl libraries need to be loaded
# before all the other packages. However, its tests need to be loaded after all
# packages have had their Tcl libraries loaded.
apm_load_packages -load_libraries_p 0 -load_queries_p 0 -packages acs-tcl
if { ![nsv_exists rp_properties request_count] } {
# security-init.tcl has not been invoked, so it's safe to say that the
# core has not been properly initialized and the server will probably
# fail catastrophically.
bootstrap_fatal_error "The request processor routines have not been loaded."
}
ns_log Notice "$proc_name: Done loading OpenACS."
}]
if { $errno && $errno != 2 } {
# An error occured while bootstrapping. Handle it by registering a filter
# to display the error message, rather than leaving the site administrator
# to guess what broke.
# If the $errorCode is "bootstrap_fatal_error", then the error was explicitly
# thrown by a call to bootstrap_fatal_error. If not, bootstrap_fatal_error was
# never called, so we need to call it now.
global errorCode
if { [string compare $errorCode "bootstrap_fatal_error"] } {
bootstrap_fatal_error "Error during bootstrapping" 0
}
}
#####
#
# Perform database specific checks for the bootstrap and installer scripts.
#
#####
proc db_bootstrap_checks { errors error_p } {
upvar $errors my_errors
upvar $error_p my_error_p
foreach pool [db_available_pools {}] {
if { [catch { set db [ns_db gethandle -timeout 15 $pool]}] || ![string compare $db ""] } {
# This should never happened - we were able to grab a handle previously, why not now?
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...
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>"
set my_error_p 1
}
ns_db releasehandle $db
}
}
if { ![info exists my_error_p] } {
# DRB: I've got the SQL to pick the version to drop in later...what we really want,
# though, is Oracle's "compat version" number and I'm not sure how to get it (it is
# reported as 8.1.0 during the Oracle installation process)
nsv_set ad_database_version . "8.1.6"
}
}
proc db_installer_checks { errors error_p } {
upvar $errors my_errors
upvar $error_p my_error_p
# Date format is a globally defined value for Oracle, so we only need to check it once
# for correctness.
if { [db_string sysdate "select sysdate from dual"] != [ns_fmttime [ns_time] "%Y-%m-%d"] } {
# See if NLS_DATE_FORMAT is set correctly
append my_errors "<hr><P><B>"
append my_errors [db_string sysdate "select sysdate from dual"]
append my_errors "<P>"
append my_errors [ns_fmttime [ns_time] "%Y-%m-%d"]
append my_errors "</B><P><hr>"
append my_errors "<li><p><b>Your Oracle driver is correctly installed, however
Oracle's date format should be set to <i>YYYY-MM-DD</i>.</b></p>\n"
set my_error_p 1
}
}
# If we're using Oracle we have to check that the korn shell's available and a couple of
# other similar things.
proc db_helper_checks { errors error_p } {
upvar $errors my_errors
upvar $error_p my_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
# check, so let them check!
if {![info exists env(ORACLE_HOME)]} {
append my_errors "<li><p>
<strong>There is no <code>ORACLE_HOME</code> variable in your environment.
This variable must be set in order for the Oracle software to work properly (even on an Oracle client).</strong><p>
"
set my_error_p 1
}
# First we look for the overall presence of interMedia
db_1row check_role "SELECT (SELECT COUNT(*) FROM USER_ROLE_PRIVS WHERE GRANTED_ROLE = 'CTXAPP') ctxrole,
(SELECT COUNT(*) FROM ALL_USERS WHERE USERNAME = 'CTXSYS') ctxuser,
USER thisuser FROM DUAL"
if {$ctxuser < 1} {
append my_errors "<li><p><strong>The CTXSYS user does not exist in your database. This means
that interMedia is probably not installed. interMedia is needed for full-text searching.
To install it, you may either use the Oracle Database Assistant (<code>dbassist</code> under UNIX) to re-create
your database or add the missing capabilities (JServer and interMedia), or, if you're feeling adventurous, look at running
the SQL*Plus script <code>\$ORACLE_HOME/ctx/admin/dr0inst.sql</code> <em>on the Oracle server</em>.</strong></p>"
set my_error_p 1
}
if {$ctxrole < 1} {
append my_errors "<li><p><strong>The <code>CTXAPP</code> role has not been granted to this database
user (<code>$thisuser</code>). Without the role, it will be impossible to synchronize interMedia indexes
and several other tasks. As a dba user (e.g., <code>SYSTEM</code>), grant the role:
<blockquote><pre>
GRANT CTXAPP TO $thisuser;
</pre></blockquote>
If you still receive this error after restarting AOLserver, you may need to include the role
as a \"default\" role for the user. To do so, run the following as a dba user such as <code>SYSTEM</code>:
<blockquote><pre>
ALTER USER $thisuser DEFAULT ROLE ALL;
</pre></blockquote>
</strong></p>"
set my_error_p 1
}
# drop in a function to convert an Oracle supplied procedure into
# function output
set sql "CREATE OR REPLACE FUNCTION oacs_get_oracle_version(p_which IN VARCHAR2 DEFAULT 'version')
RETURN VARCHAR2 AS
v_version VARCHAR2(50);
v_compat VARCHAR2(50);
BEGIN
DBMS_UTILITY.DB_VERSION( v_version, v_compat );
IF LOWER(p_which) = 'version' THEN
RETURN v_version;
ELSIF LOWER(p_which) = 'compatibility' THEN
RETURN v_compat;
ELSE
RETURN '';
END IF;
END oacs_get_oracle_version;"
db_dml create_oacs_get_oracle_version $sql
db_1row get_platform_dbversion "SELECT DBMS_UTILITY.PORT_STRING platform, oacs_get_oracle_version('version') dbversion FROM DUAL"
# the following isn't used currently, but maybe someday we'll give the user
# a snapshot of what we think their environment is
switch -regexp -- $platform {
{^IBMPC/WIN_NT.*} {set platformname "Windows"}
{^SVR4-be-.*} {set platformname "Solaris"}
{^IBM AIX/RS.*} {set platformname "RS/6000 AIX"}
{^HP9000.*} {set platformname "HP-UX on HP 9000"}
{^Linuxi386.*} {set platformname "Linux on Intel" }
{^DEC Alpha OSF/1} {set platformname "Tru64 UNIX on Alpha" }
}
set dbversion_list [split $dbversion .]
set dbversion_major [lindex $dbversion_list 0]
set dbversion_minor [lindex $dbversion_list 1]
set dbversion_patch [lindex $dbversion_list 2]
set dbversion_total [expr {($dbversion_major * 1000000) + ($dbversion_minor * 1000) + ($dbversion_patch)}]
# Check for Oracle 8.1.6 and before running on Linux. If so, we've got to tell the user
# what to do about lack of INSO filter support in interMedia there.
if {($dbversion_total <= 8001006) && [string match $platform "Linuxi386*"]} {
append my_errors "<li><p><strong>You are running Oracle $dbversion under Linux (Intel). Versions of
Oracle prior to 8.1.7 lack the INSO filters used by interMedia. (These filters convert content
stored in a variety of proprietary formats (e.g., Microsoft Word) into plain text or HTML for indexing
and searching.) The best solution is to upgrade the server to Oracle 8.1.7. A workaround is to create the
file <code>\$ORACLE_HOME/ctx/bin/ctxhx</code>
<em>on the Oracle server</em> containing the following lines:
<blockquote><pre>
#!/bin/sh
cat \$1 > \$2
</pre></blockquote>
This is a simple shell script that just copies the input onto the output. This will work fine
for the HTML and text documents generally stored in this toolset. After saving this file,
be sure to give it the proper ownership and permissions:
<blockquote><pre>
chown oracle:oinstall \$ORACLE_HOME/ctx/bin/ctxhx
chmod 755 \$ORACLE_HOME/ctx/bin/ctxhx
</pre></blockquote>
</strong><p>"
set my_error_p 1
}
# do some cleanup
db_dml drop "DROP FUNCTION oacs_get_oracle_version"
# ksh must be installed for Oracle's loadjava to work.
if { ![ad_windows_p] && ![file exists "/bin/ksh"] } {
if {[file exists "/usr/bin/ksh"]} {
set usr_bin_p 1
} else {
set usr_bin_p 0
}
if {!($usr_bin_p)} {
append my_errors "<li><p><strong>The file <code>/bin/ksh</code> is not present. This file is the Korn shell and
is required by Oracle's <code>loadjava</code> utility for adding Java class files to the database.
It must be installed in order for OpenACS to install properly. Please obtain it from
<a href=\"http://www.kornshell.com/\">David Korn's Kornshell page</a>. (Alternatively, <code>pdksh</code>
(a ksh clone) has been reported to work.) Install it and provide
a symbolic link from <code>/bin/ksh</code> to the executable. Alternatively, <code>loadjava</code>
is known to work if <code>/bin/sh</code> is linked to <code>/bin/ksh</code>. You can do this by typing
as root:
<blockquote><pre>
ln -s /bin/sh /bin/ksh
</blockquote></pre>
</strong></p>"
} else {
append my_errors "<li><p>You have the Korn shell installed in <code>/usr/bin/ksh</code>, but Oracle's
<code>loadjava</code> program expects in in <code>/bin/ksh</code>. As root, please create
a symbolic link.
<blockquote><pre>
ln -s /usr/bin/ksh /bin/ksh
</pre></blockquote></strong></p>"
}
set my_error_p 1
}
}
#####
#
# Perform database-specific checks for the bootstrap and installer scripts.
#
#####
proc db_bootstrap_checks { errors error_p } {
upvar $errors my_errors
upvar $error_p my_error_p
set my_errors "We found the following problems with your PostgreSQL installation:<p><ul>\n"
foreach pool [db_available_pools {}] {
if { [catch { set db [ns_db gethandle -timeout 15 $pool]}] || ![string compare $db ""] } {
# This should never happened - we were able to grab a handle previously, why not now?
append my_errors "<li>(db_bootstrap_checks) Internal error accessing pool \"$pool\".<br>"
set my_error_p 1
} else {
ns_db releasehandle $db
}
}
set db [ns_db gethandle [lindex [db_available_pools {}] 0]]
# We'll just run the rest of the tests on a single pool ...
if { [catch { set version [ns_set value [ns_db 1row $db "select version()"] 0] }] } {
append my_errors "<li>(db_bootstrap_checks) Internal error querying for PostgreSQL version.\n"
set my_error_p 1
set version 0
} else {
# DRB: We only want the major.minor portion of the version, i.e. 7.1 not 7.1.3
regexp {PostgreSQL ([0-9]*\.[0-9]*)} $version all version
nsv_set ad_database_version . $version
}
if { $version < 7.3 } {
append my_errors "<li>Your installed version of Postgres is too old. Please install PostgreSQL 7.2 or later.\n"
set my_error_p 1
}
if { [catch { ns_pg_bind 1row $db "select count(*) from pg_class" }] } {
append my_errors "<li>Your Postgres driver is either too old or was not compiled with <code>ACS=1</code>. Please update to a version 2.3 or higher and compile it with <code>ACS=1</code>.\n"
set my_error_p 1
}
## Make sure the __test__() function is dropped if it exists
if {![empty_string_p [ns_db 0or1row $db "select proname from pg_proc where proname = '__test__' and pronargs = 0"]]} {
catch { ns_db dml $db "drop function __test__();" }
}
if { [catch { ns_db dml $db "create function __test__() returns integer as 'begin end;' language 'plpgsql'" } errmsg] } {
append my_errors "<li>PL/pgSQL has not been created in your database. Execute the following command while logged in as a PostgreSQL \"superuser\": <blockquote><pre>createlang plpgsql your_database_name</pre></blockquote>\n"
set my_error_p 1
} elseif { [catch { ns_db dml $db "drop function __test__();" } errmsg] } {
append my_errors "<li>An unexpected error was encountered while testing for the of existence PL/pgSQL. Here's the error messsage: <blockquote><pre>$errmsg</pre></blockquote>\n"
set my_error_p 1
}
# RBM: Remove check for 7.1 since we don't support it anymore. 2002-01-14
ns_db releasehandle $db
if { [info exists my_error_p] } {
append my_errors "</ul>"
} else {
unset my_errors
}
}
proc db_installer_checks { errors error_p } {
}
proc db_helper_checks { errors error_p } {
}
# Initializes datastrctures for the installer.
# @creation-date 02 October 2000
# @author Bryan Quinn
# @cvs-id $Id$
# Create a mutex for the installer
nsv_set acs_installer mutex [ns_mutex create]
This diff is collapsed.
This diff is collapsed.
##############
#
# Get configuration parameters
#
#############
install_page_contract [install_mandatory_params] [install_optional_params]
# Default all system emails to the administrators email
foreach var_name {system_owner admin_owner host_administrator outgoing_sender new_registrations} {
if { [empty_string_p [set $var_name]] } {
set $var_name $email
}
}
##############
#
# System setting validation
#
#############
if { [string compare $password $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>.
"
return
}
##############
#
# Install data model
#
#############
ns_write [install_header 200 ""]
if { ![install_good_data_model_p] } {
install_do_data_model_install
} else {
ns_write "Kernel data model already installed."
# If kernel is installed it probably means this page has already been requested,
# let's exit
return
}
##############
#
# Install packages
#
#############
install_do_packages_install
##############
#
# Load message catalogs
#
#############
# Doing this before restart so that keys are available in init files on startup
ns_write "<p>Loading message catalogs..."
lang::catalog::import -initialize
ns_write " <p>Done.<p>"
##############
#
# Secret tokens
#
#############
ns_write "<p>Generating secret tokens..."
populate_secret_tokens_db
ns_write " <p>Done.<p>"
##############
#
# Admin create
#
#############
if { [empty_string_p $username] } {
set username $email
}
if { ![db_string user_exists {
select count(*) from parties where email = lower(:email)
}] } {
db_transaction {
set user_id [ad_user_new \
$email \
$first_names \
$last_name \
$password \
"" \
"" \
"" \
"t" \
"approved" \
"" \
$username]
if { !$user_id } {
global errorInfo
install_return 200 "Unable to Create Administrator" "
Unable to create the site-wide administrator:
<blockquote><pre>[ns_quotehtml $errorInfo]</pre></blockquote>
Please <a href=\"javascript:history.back()\">try again</a>.
"
return
}
# stub util_memoize_flush...
rename util_memoize_flush util_memoize_flush_saved
proc util_memoize_flush {args} {}
permission::grant -party_id $user_id -object_id [acs_lookup_magic_object security_context_root] -privilege "admin"
# nuke stub
rename util_memoize_flush {}
rename util_memoize_flush_saved util_memoize_flush
}
}
##############
#
# System settings
#
#############
set kernel_id [db_string acs_kernel_id_get {
select package_id from apm_packages
where package_key = 'acs-kernel'
}]
foreach { var param } {
system_url SystemURL
system_name SystemName
publisher_name PublisherName
system_owner SystemOwner
admin_owner AdminOwner
host_administrator HostAdministrator
outgoing_sender OutgoingSender
} {
ad_parameter -set [set $var] -package_id $kernel_id $param
}
# set the Main Site RestrictToSSL parameter
set main_site_id [db_string main_site_id_select {
select package_id from apm_packages
where instance_name = 'Main Site'
}]
ad_parameter -set "acs-admin/*" -package_id $main_site_id RestrictToSSL
ad_parameter -set $new_registrations -package_id $main_site_id NewRegistrationEmailAddress
# We're done - kill the server (will restart if server is setup properly)
ad_schedule_proc -thread t -once t 1 ns_shutdown
set post_installation_message \
[parameter::get_from_package_key -package_key acs-bootstrap-installer \
-parameter post_installation_message \
-default ""]
ns_write "<b>Installation finished</b>
<p> The server has been shut down. Normally, it should come back up by itself after a minute or so. </p>
<p> If not, please check your server error log, or contact your system administrator. </p>"
if { ![string equal $post_installation_message ""] } {
ns_write $post_installation_message
} else {
ns_write "
<p> When the server is back up you can visit <a href=\"/acs-admin/\">the site-wide administration pages</a> </p>"
}
ns_write [install_footer]
# In case there is a database failure, return a static html page.
# It needs to be enabled manually by the admin of the site. The path
# is hardcoded: www/global/site-failure.html
proc site_failure_handler { conn arg why } {
ns_returnfile 500 text/html "[acs_root_dir]/www/global/site-failure.html"
return "filter_return"
}
# Register the handler for all URLs.
ns_register_filter preauth GET * site_failure_handler
ns_register_filter preauth POST * site_failure_handler
ns_register_filter preauth HEAD * site_failure_handler
This diff is collapsed.
ad_library {
Utility routines needed by the bootstrapping process.
@creation-date 4 Apr 2001
@author Don Baccus (dhogaza@pacifier.com
@cvs-id $Id$
}
ad_proc -public ad_find_all_files {
{
-include_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.
} {
# Use the examined_files array to track files that we've examined.
array set examined_files [list]
# A list of files that we will return (in the order in which we
# examined them).
set files [list]
# A list of files that we still need to examine.
set files_to_examine [list $path]
# Perform a breadth-first search of the file tree. For each level,
# examine files in $files_to_examine; if we encounter any directories,
# add contained files to $new_files_to_examine (which will become
# $files_to_examine in the next iteration).
while { [incr max_depth -1] > 0 && [llength $files_to_examine] != 0 } {
set new_files_to_examine [list]
foreach file $files_to_examine {
# Only examine the file if we haven't already. (This is just a safeguard
# in case, e.g., Tcl decides to play funny games with symbolic links so
# we end up encountering the same file twice.)
if { ![info exists examined_files($file)] } {
# Remember that we've examined the file.
set examined_files($file) 1
if { [empty_string_p $check_file_func] || [eval [list $check_file_func $file]] } {
# If it's a file, add to our list. If it's a
# directory, add its contents to our list of files to
# examine next time.
if { [file isfile $file] } {
lappend files $file
} elseif { [file isdirectory $file] } {
if { $include_dirs == 1 } {
lappend files $file
}
set new_files_to_examine [concat $new_files_to_examine [glob -nocomplain "$file/*"]]
}
}
}
}
set files_to_examine $new_files_to_examine
}
return $files
}
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment