- Publicity: Public Only All
apm-admin-procs.tcl
Definitions for the APM administration interface.
- Location:
- packages/acs-admin/tcl/apm-admin-procs.tcl
- Created:
- 29 September 2000
- Author:
- Bryan Quinn <bquinn@arsdigita.com>
- CVS Identification:
$Id: apm-admin-procs.tcl,v 1.32.2.15 2024/08/05 14:20:21 gustafn Exp $
Procedures in this file
- apm_header (public, deprecated)
- apm_higher_version_installed_p (public)
- apm_shell_wrap (public, deprecated)
Detailed information
apm_header (public, deprecated)
apm_header [ -form form ] [ args... ]
Deprecated. Invoking this procedure generates a warning.
Generates HTML for the header of a page (including context bar). Must only be used for APM admin pages (under /acs-admin/apm). We are adding the APM index page to the context bar so it doesn't have to be added on each page
- Switches:
- -form (optional)
- Author:
- Peter Marklund
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
apm_higher_version_installed_p (public)
apm_higher_version_installed_p package_key version_name
- Parameters:
- package_key (required)
- The package in question.
- version_name (required)
- The name of the currently installed version.
- Returns:
- The return value of this procedure doesn't really fit with its name. What it returns is:
- -1 if there's already a higher version of the given package installed than the version_name you gave it.
- 0 if the same version is installed as the one you supplied.
- 1 if the version you gave is higher than the highest version installed, or no version of this package is installed.
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- apm_higher_version_installed_p
apm_shell_wrap (public, deprecated)
apm_shell_wrap cmd
Deprecated. Invoking this procedure generates a warning.
The value provided by this proc is unclear, quite hardcoded, and it is used nowhere in usptream code.
- Parameters:
- cmd (required)
- Returns:
- a command string, wrapped it shell-style (with backslashes) in case lines get too long.
- See Also:
- many possible plain tcl idioms
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
Content File Source
ad_library { Definitions for the APM administration interface. @creation-date 29 September 2000 @author Bryan Quinn (bquinn@arsdigita.com) @cvs-id $Id: apm-admin-procs.tcl,v 1.32.2.15 2024/08/05 14:20:21 gustafn Exp $ } ad_proc -private apm_parameter_section_slider {package_key} { Build a dynamic section dimensional slider. } { set sections [db_list apm_parameter_sections { select distinct(section_name) from apm_parameters where package_key = :package_key }] if { [llength $sections] > 1 } { lappend section_list [list $package_key $package_key [list "where" "section_name is null"]] foreach section $sections { if { $section ne "" } { lappend section_list [list $section $section [list "where" "section_name = [ns_dbquotevalue $section]"]] } } lappend section_list [list all "All" [list]] return [list [list section_name "Section:" $package_key $section_list]] } else { return "" } } ad_proc -deprecated apm_header { { -form "" } args } { Generates HTML for the header of a page (including context bar). Must only be used for APM admin pages (under /acs-admin/apm). We are adding the APM index page to the context bar so it doesn't have to be added on each page @author Peter Marklund } { set apm_title "Package Manager" set apm_url "/acs-admin/apm/" if { [llength $args] == 0 } { set title $apm_title set context_bar [ad_context_bar $title] } else { set title [lindex $args end] set context [concat [list [list $apm_url $apm_title]] $args] set cmd [list ad_context_bar --] foreach elem $context { lappend cmd $elem } set context_bar [eval $cmd] # this is rather a hack, but just needed for streaming output # a more general solution can be provided at some later time... regsub "#acs-kernel.Main_Site#" $context_bar \ [_ acs-kernel.Main_Site] context_bar } append body [ad_header $title ""] "\n" if {$form ne ""} { append body "<form $form>" } return "$body\n <h3>$title</h3> $context_bar <hr> " } ad_proc -deprecated apm_shell_wrap { cmd } { The value provided by this proc is unclear, quite hardcoded, and it is used nowhere in usptream code. @see many possible plain tcl idioms @return a command string, wrapped it shell-style (with backslashes) in case lines get too long. } { set out "" set line_length 0 foreach element $cmd { if { $line_length + [string length $element] > 72 } { append out "\\\n " set line_length 4 } append out "$element " incr line_length [expr { [string length $element] + 1 }] } append out "\n" } d_proc -private apm_package_selection_widget { pkg_info_list {to_install ""} {operation "all"} {form pkgsForm} } { Provides a widget for selecting packages. Displays dependency information if available. @param pkg_info_list list of package infos for all packages to be listed @param to_install list of package_keys to install @param operation filter for added operations (all, upgrade, install) } { if {$pkg_info_list eq ""} { return "" } set counter 0 if {[llength $to_install] > 0} { set label [dict get {install Install upgrade Upgrade all Install/Update} $operation] } else { set label [subst { <input type="checkbox" name="_dummy" id="bulkaction-control" title="[_ acs-templating.lt_Checkuncheck_all_rows]"> }] template::add_event_listener \ -id bulkaction-control \ -preventdefault=false \ -script [subst {acs_ListCheckAll('$form', this.checked);}] } set widget [subst { <blockquote><table class='list-table' cellpadding='3' cellspacing='5' summary="Available Packages"> <tr class='list-header'><th>$label</th><th>Package</th><th>Package Key</th><th>Comment</th></tr> }] foreach pkg_info $pkg_info_list { incr counter set package_key [pkg_info_key $pkg_info] set package_path [pkg_info_path $pkg_info] set spec_file [pkg_info_spec $pkg_info] set package [apm_read_package_info_file $spec_file] set package_name [dict get $package package-name] set version_name [dict get $package name] set id $form-$package_key ns_log Debug "Selection widget: $package_key, Dependency: [pkg_info_dependency_p $pkg_info]" if { [pkg_info_dependency_p $pkg_info] == "t" } { # # Dependency passed. # set checked [expr { $package_key in $to_install ? "checked " : "" }] append widget [subst { <tr class='[expr {$counter % 2 ? "odd" : "even"}]'> <td align='center'><input type='checkbox' $checked name='package_key' value='$package_key' id='$id'></td> <td>$package_name $version_name</td> <td>$package_key</td> <td><span style='color:green'>Dependencies satisfied.</span></td> </tr> }] } elseif { [pkg_info_dependency_p $pkg_info] == "f" } { # # Dependency failed. # append widget [subst { <tr class='[expr {$counter % 2 ? "odd" : "even"}]'> <td align='center'><input type='checkbox' name='package_key' value='$package_key' id='$id'></td> <td>$package_name $version_name</td> <td>$package_key</td> <td><span style='color:red'> }] foreach comment [pkg_info_comment $pkg_info] { append widget "$comment<br>" } append widget \ </span></td> \ </tr> } else { # # No dependency information. # See if the install is already installed with a higher version number. # if {[apm_package_registered_p $package_key]} { set higher_version_p [apm_higher_version_installed_p $package_key $version_name] } else { set higher_version_p 2 } if {$higher_version_p == 2 } { if {$operation eq "upgrade"} { incr counter -1 continue } set comment "New install." } elseif {$higher_version_p == 1 } { if {$operation eq "install"} { incr counter -1 continue } set comment "Upgrade." } elseif {$higher_version_p == 0} { set comment "Package version already installed." } else { set comment "Installing older version of package." } set install_checked [expr {$package_key in $to_install ? "checked" : ""}] append widget [subst { <tr class='[expr {$counter % 2 ? "odd" : "even"}]'> <td align='center'><input type='checkbox' $install_checked name='package_key' value='$package_key' id='$id'></td> <td>$package_name $version_name</td> <td>$package_key</td> <td>$comment</td> </tr> }] } } if {$counter == 0} { set widget "" } else { append widget {</table></blockquote>} } return $widget } d_proc -public apm_higher_version_installed_p { package_key version_name } { @param package_key The package in question. @param version_name The name of the currently installed version. @return The return value of this procedure doesn't really fit with its name. What it returns is: <ul> <li>-1 if there's already a higher version of the given package installed than the version_name you gave it. <li>0 if the same version is installed as the one you supplied. <li>1 if the version you gave is higher than the highest version installed, or no version of this package is installed. </ul> } { set package_version_name [apm_highest_version_name $package_key] if {$package_version_name eq ""} { return 1 } return [apm_version_names_compare $version_name $package_version_name] } d_proc -private apm_build_repository { {-debug:boolean 0} {-channels *} {-head_channel HEAD} } { Rebuild the repository on the local machine. Only useful for the openacs.org site. Adapted from Lars' build-repository.tcl page. @param debug Set to 1 to test with only a small subset of packages instead of the whole cvs tree. @param head_channel The artificial branch label to apply to HEAD. Should be one minor version past the current release. @param channels Generate apm files for the matching channels only @author Lars Pind (lars@collaboraid.biz) @return 0 for success. Also outputs debug messages to log. } { #---------------------------------------------------------------------- # Configuration Settings #---------------------------------------------------------------------- set cd_helper [file join $::acs::rootdir bin cd-helper] set cvs_command cvs set cvs_root :pserver:anonymous@cvs.openacs.org:/cvsroot set work_dir [file join $::acs::rootdir repository-builder][file separator] set repository_dir [file join $::acs::rootdir www repository][file separator] set repository_url https://openacs.org/repository/ set exclude_package_list {} set channel_index_template [template::themed_template /packages/acs-admin/www/apm/repository-channel-index] set index_template [template::themed_template /packages/acs-admin/www/apm/repository-index] #---------------------------------------------------------------------- # Prepare output #---------------------------------------------------------------------- ns_log Debug "Repository: Building Package Repository" #---------------------------------------------------------------------- # Find available channels #---------------------------------------------------------------------- # Prepare work dir file mkdir $work_dir cd $work_dir set msg [ exec $cd_helper $work_dir $cvs_command -d $cvs_root -z3 co openacs-4/readme.txt ] set output [ exec $cd_helper $work_dir $cvs_command -d $cvs_root -z3 log -h openacs-4/readme.txt ] set lines [split $output \n] for { set i 0 } { $i < [llength $lines] } { incr i } { if { [string trim [lindex $lines $i]] eq "symbolic names:" } { incr i break } } array set channel_tag [list] array set channel_bugfix_version [list] for { } { $i < [llength $lines] } { incr i } { # Tag lines have the form tag: cvs-version # openacs-5-0-0-final: 1.25.2.5 if { ![regexp {^\s+([^:]+):\s+([0-9.]+)} [lindex $lines $i] match tag_name version_name] } { break } # Look for tags named 'openacs-x-y-compat' if { [regexp {^openacs-([1-9][0-9]*-[0-9]+)-compat$} $tag_name match oacs_version] } { lassign [split $oacs_version "-"] major_version minor_version if { $major_version >= 5 && $minor_version >= 3} { set channel "${major_version}-${minor_version}" ns_log Notice "Repository: Found channel $channel using tag $tag_name" set channel_tag($channel) $tag_name } } elseif { [regexp {^openacs-([1-9][0-9]*-[0-9]+-[0-9]+)-final$} $tag_name match oacs_version] } { lassign [split $oacs_version "-"] major_version minor_version patch_version #ns_log Notice "Repository: tag <$tag_name> oacs version <$oacs_version> split into /$major_version/$minor_version/$patch_version/" if { $major_version >= 5 && $minor_version >= 8} { set channel "${major_version}-${minor_version}-$patch_version" ns_log Notice "Repository: Found channel $channel using tag $tag_name" set channel_tag($channel) $tag_name } } } set channel_tag($head_channel) HEAD set channel_tag(5-10) oacs-5-10 ns_log Notice "Repository: Channels are: [array get channel_tag]" #---------------------------------------------------------------------- # Read all package .info files, building manifest file #---------------------------------------------------------------------- # Wipe and re-create the working directory file delete -force -- $work_dir file mkdir ${work_dir} set update_pretty_date [lc_time_fmt [clock format [clock seconds] -format "%Y-%m-%d %T"] %c] #cd $work_dir foreach channel [lsort -decreasing [array names channel_tag]] { if {![string match $channels $channel]} continue ns_log Notice "Repository: Channel $channel using tag $channel_tag($channel)" # Wipe and re-create the checkout directory file delete -force -- "${work_dir}openacs-4" file delete -force -- "${work_dir}dotlrn" file mkdir "${work_dir}dotlrn/packages" # Prepare channel directory set channel_dir "${work_dir}repository/$channel/" file mkdir $channel_dir # Store the list of packages we've seen for this channel, so we don't include the same package twice # Seems odd, but we have to do this given the forked packages sitting in /contrib set packages [list] # Checkout from the tag given by channel_tag($channel) if { $debug_p } { # Smaller list for debugging purposes set checkout_list [list $work_dir $cvs_root openacs-4/packages/acs-core-docs ] } else { # Full list for real use set checkout_list [list \ $work_dir $cvs_root openacs-4/packages \ $work_dir $cvs_root openacs-4/contrib/packages] } foreach { cur_work_dir cur_cvs_root cur_module } $checkout_list { #cd $cur_work_dir set cmd [list exec $cd_helper $cur_work_dir cvs -d $cur_cvs_root -z3 co] if { $channel_tag($channel) ne "HEAD" } { lappend cmd -r $channel_tag($channel) } catch { {*}$cmd $cur_module } output ns_log Notice "Repository: $cur_module [llength $output] files ($channel_tag($channel))" } #cd $work_dir set manifest "<manifest>\n" template::multirow create packages \ package_path package_key version pretty_name \ package_type summary description \ release_date vendor_url vendor \ maturity maturity_text \ license license_url download_url set work_dirs [list ${work_dir}openacs-4/packages ${work_dir}openacs-4/contrib/packages ] foreach packages_dir $work_dirs { foreach spec_file [lsort [apm_scan_packages $packages_dir]] { set package_path [file join {*}[lrange [file split $spec_file] 0 end-1]] set package_key [lindex [file split $spec_file] end-1] if { $package_key in $exclude_package_list } { ns_log Debug "Repository: Package $package_key is on list of packages to exclude - skipping" continue } if { [array exists pkg_info] } { array unset pkg_info } if { [info exists pkg_info] } { unset pkg_info } ad_try { array set pkg_info [apm_read_package_info_file $spec_file] if { $pkg_info(package.key) in $packages } { ns_log Debug "Repository: Skipping package $package_key, because we already have another version of it" } else { lappend packages $pkg_info(package.key) append manifest \ " <package>" \n \ " <package-key>[ns_quotehtml $pkg_info(package.key)]</package-key>\n" \ " <version>[ns_quotehtml $pkg_info(name)]</version>\n" \ " <pretty-name>[ns_quotehtml $pkg_info(package-name)]</pretty-name>\n" \ " <package-type>[ns_quotehtml $pkg_info(package.type)]</package-type>\n" \ " <summary>[ns_quotehtml $pkg_info(summary)]</summary>\n" \ " <description format=\"[ns_quotehtml $pkg_info(description.format)]\">" \ [ns_quotehtml $pkg_info(description)] "</description>\n" \ " <release-date>[ns_quotehtml $pkg_info(release-date)]</release-date>\n" \ " <vendor url=\"[ns_quotehtml $pkg_info(vendor.url)]\">" \ [ns_quotehtml $pkg_info(vendor)] "</vendor>\n" \ " <license url=\"[ns_quotehtml $pkg_info(license.url)]\">" \ [ns_quotehtml $pkg_info(license)] "</license>\n" \ " <maturity>$pkg_info(maturity)</maturity>\n" foreach e $pkg_info(install) { append manifest " <install package=\"$e\"/>\n" } set apm_file "${channel_dir}${pkg_info(package.key)}-${pkg_info(name)}.apm" ns_log Notice "Repository: Building package $package_key for channel $channel" set files [apm_get_package_files \ -all \ -include_data_model_files \ -all_db_types \ -package_key $pkg_info(package.key) \ -package_path $package_path] if { [llength $files] == 0 } { ns_log Notice "Repository: No files in package" } else { ns_log Notice "Repository: [llength $files] files in package $pkg_info(package.key) ($channel)" set cmd [list exec [apm_tar_cmd] cf - 2>/dev/null] # The path to the 'packages' directory in the checkout set packages_root_path [file join {*}[lrange [file split $spec_file] 0 end-2]] set fp [ad_opentmpfile tmp_filename] foreach file $files { puts $fp $package_key/$file } close $fp lappend cmd -C $packages_root_path --files-from $tmp_filename lappend cmd "|" [apm_gzip_cmd] -c ">" $apm_file ns_log Notice "Executing: exec $cd_helper $packages_root_path $cmd" if {[catch "exec $cd_helper $packages_root_path $cmd" errmsg]} { ns_log Error "Error during tar in repository creation for\ file ${channel_dir}$pkg_info(package.key)-$pkg_info(name).apm:\ \n$errmsg\n$::errorCode,$::errorInfo" } file delete -- $tmp_filename } set apm_url "${repository_url}$channel/$pkg_info(package.key)-$pkg_info(name).apm" template::multirow append packages \ $package_path $package_key $pkg_info(name) $pkg_info(package-name) \ $pkg_info(package.type) $pkg_info(summary) $pkg_info(description) \ $pkg_info(release-date) $pkg_info(vendor.url) $pkg_info(vendor) \ $pkg_info(maturity) $pkg_info(maturity_text) \ $pkg_info(license) $pkg_info(license.url) $apm_url append manifest " <download-url>$apm_url</download-url>\n" foreach elm $pkg_info(provides) { append manifest " <provides " \ "url=\"[ns_quotehtml [lindex $elm 0]]\" " \ "version=\"[ns_quotehtml [lindex $elm 1]]\" />\n" } foreach elm $pkg_info(requires) { append manifest " <requires " \ "url=\"[ns_quotehtml [lindex $elm 0]]\" " \ "version=\"[ns_quotehtml [lindex $elm 1]]\" />\n" } append manifest " </package>\n" } } on error {errorMsg} { ns_log Notice "Repository: Error on spec_file $spec_file: $errorMsg\n$::errorInfo\n" } } } append manifest "</manifest>\n" ns_log Notice "Repository: Writing $channel manifest to ${channel_dir}manifest.xml" set fw [open "${channel_dir}manifest.xml" w] puts $fw $manifest close $fw ns_log Notice "Repository: Writing $channel index page to ${channel_dir}index.adp" set fw [open "${channel_dir}index.adp" w] set packages [lsort $packages] puts $fw "<master>\n<property name=\"doc(title)\">OpenACS $channel Compatible Packages</property>\n\n" puts $fw "<h1>OpenACS $channel (CVS tag $channel_tag($channel))</h1> <p>Packages can be installed with the OpenACS Automated Installer on your OpenACS site at <code>/acs-admin/install</code>. Only packages potentially compatible with your OpenACS kernel will be shown.</p> " set category_title(core) "Core Packages" set package_keys(core) { acs-admin acs-api-browser acs-authentication acs-automated-testing acs-bootstrap-installer acs-content-repository acs-core-docs acs-kernel acs-lang acs-mail-lite acs-messaging acs-reference acs-service-contract acs-subsite acs-tcl acs-templating ref-timezones acs-translations intermedia-driver openacs-default-theme notifications search tsearch2-driver } set category_title(common-app) "Common Applications" set package_keys(common-app) { xowiki xotcl-request-monitor file-storage acs-developer-support forums calendar news faq } set category_title(extra) "Extra Packages and Libraries" set package_keys(extra) "" foreach p $packages { if {$p ni $package_keys(core) && $p ni $package_keys(common-app)} { lappend package_keys(extra) $p } } foreach category {core common-app extra} { template::multirow create pkgs \ package_path package_key version pretty_name \ package_type summary description \ release_date vendor_url vendor \ maturity maturity_text \ license license_url download_url template::multirow foreach packages { if {$package_key in $package_keys($category)} { template::multirow append pkgs \ $package_path $package_key $version $pretty_name \ $package_type $summary $description \ $release_date $vendor_url $vendor \ $maturity $maturity_text \ $license $license_url $download_url } } puts $fw "\n<h2>$category_title($category)</h2>\n" puts $fw [template::adp_include $channel_index_template \ [list channel $channel &pkgs pkgs update_pretty_date $update_pretty_date]] } close $fw ns_log Notice "Repository: Channel $channel complete." } ns_log Notice "Repository: Finishing Repository" foreach channel [array names channel_tag] { if {[regexp {^([1-9][0-9]*)-([0-9]+)$} $channel . major minor]} { # # *-compat channels: The "patchlevel" of these channels is # the highest possible value, higher than the released # -final channels. # set tag_order([format %.3d $major]-[format %.3d $minor]-999) $channel set tag_label($channel) "OpenACS $major.$minor" } elseif {[regexp {^([1-9][0-9]*)-([0-9]+)-([0-9]+)$} $channel . major minor patch]} { # # *-final channels: a concrete patchlevel is provided. # set tag_order([format %.3d $major]-[format %.3d $minor]-[format %.3d $patch]) $channel set tag_label($channel) "OpenACS $major.$minor.$patch" } else { set tag_order(999-999-999) $channel set tag_label($channel) "OpenACS $channel" } } # Write the index page ns_log Notice "Repository: Writing repository index page to ${work_dir}repository/index.adp" template::multirow create channels name tag label foreach key [lsort -decreasing [array names tag_order]] { set channel $tag_order($key) template::multirow append channels $channel $channel_tag($channel) $tag_label($channel) } set fw [open "${work_dir}repository/index.adp" w] puts $fw "<master>\n<property name=\"doc(title)\">OpenACS Package Repository</property>\n\n" puts $fw [template::adp_include -- $index_template \ [list &channels channels update_pretty_date $update_pretty_date]] close $fw # Add a redirector for outdated releases set fw [open "${work_dir}repository/index.vuh" w] puts $fw "ns_returnredirect /repository/" close $fw # Without the trailing slash set work_repository_dirname "${work_dir}repository" set repository_dirname [string range $repository_dir 0 end-1] set repository_bak "[string range $repository_dir 0 end-1]_bak" ns_log Notice "Repository: Moving work repository $work_repository_dirname to live repository dir at <a href=\"/repository\/>$repository_dir</a>\n" if { [file exists $repository_bak] } { file delete -force -- $repository_bak } if { [file exists $repository_dirname] } { file rename -- $repository_dirname $repository_bak } file rename -- $work_repository_dirname $repository_dirname ns_log Debug "Repository: DONE" return 0 } d_proc -private apm_git_repo_tags { -path:required } { Extracts the available tags from an OpenACS Git repo. This assumes the specific Git setup for our repo, hence it is meant for internal use only. @return list of tag names. } { set cd_helper [file join $::acs::rootdir bin cd-helper] set git_command git set output [exec $cd_helper $path $git_command tag] return [regexp -line -inline -all {openacs-\d+-\d+(-\d+)?-(compat|final)} $output] } d_proc -private apm_git_repo_branches { -path:required } { Extracts the available branches from an OpenACS Git repo. This assumes the specific Git setup for our repo, hence it is meant for internal use only. @return list of branch names } { set cd_helper [file join $::acs::rootdir bin cd-helper] set git_command git set output [exec $cd_helper $path $git_command branch -r] return [regexp -line -inline -all {oacs-\d+-\d+} $output] } d_proc -private apm_git_repo_channels { -path:required } { Extracts the available tags and branches from an OpenACS Git repo. This assumes the specific Git setup for our repo, hence it is meant for internal use only. @return list of branch names } { set channels [apm_git_repo_branches -path $path] lappend channels {*}[apm_git_repo_tags -path $path] } d_proc -private apm_git_checkout_repo { -path:required -branch:required } { Checks out a repository branch or tag, making also sure that this is up to date via 'git pull' (if this is a branch) This assumes the specific Git setup for our repo, hence it is meant for internal use only. @return list of branch names } { set cd_helper [file join $::acs::rootdir bin cd-helper] set git_command git try { ns_log Notice "Checking out '$path'" exec -ignorestderr -- $cd_helper $path $git_command checkout $branch } on error {errmsg} { # # Checking out a branch that was already checked # out will complain. As we know the branch exists # for this repo, we are pretty confident this # error can be ignored. # ns_log notice "Checking out existing branch '$branch' for '$path' complained:" $errmsg } # # If we are on a branch, make sure repo is up to date. # if {$branch in [apm_git_repo_branches -path $path]} { ns_log Notice "Updating '$path'" exec -ignorestderr -- $cd_helper $path $git_command pull } } d_proc -private apm_git_fetch_repo { -path:required -repo:required } { Fetches a repo from the Git mirror. Clones it first when it does not exist. This assumes the specific Git setup for our repo, hence it is meant for internal use only. @return list of branch names } { set git_url https://github.com/openacs set cd_helper [file join $::acs::rootdir bin cd-helper] set git_command git set repo_dir ${path}${repo} if {[file isdirectory $repo_dir]} { # # Folder exists. We fetch from the repo to see if new branches # exist. # ns_log notice "Fetching new branches for '$repo_dir'" exec -ignorestderr -- $cd_helper $repo_dir $git_command fetch origin } else { # # Folder does not exist. Clone the repo from scratch. # ns_log notice "Cloning '${git_url}/${repo}.git' in '$repo_dir'" try { exec -ignorestderr -- $cd_helper $path $git_command clone ${git_url}/${repo}.git } on error {errmsg} { if {$repo eq "openacs-core"} { error $errmsg } # # Tolerate errors when cloning non-core packages: some # legacy packages require authentication and would fail. # ns_log warning "Could not clone '$repo' from '${git_url}/${repo}.git':" $errmsg } } } d_proc -private apm_git_build_repository { {-debug:boolean 0} {-force_fresh:boolean false} {-channels *} {-min_final_version 5.8.0} {-min_compat_version 5.3.0} } { Rebuild the repository on the local machine. Only useful for the openacs.org site. Adapted from the CVS implementation, which came from Lars' build-repository.tcl page. @param debug Set to 1 to test with only a small subset of packages and branches instead of all of them. @param force_fresh Force a frech clone of the Git repos. @param channels A string match style pattern. Generate apm files for the matching channels only } { #---------------------------------------------------------------------- # Configuration Settings #---------------------------------------------------------------------- set sep [file separator] set cd_helper [file join $::acs::rootdir bin cd-helper] set work_dir [file join $::acs::rootdir repository-builder]${sep} set repository_dir [file join $::acs::rootdir www repository]${sep} set repository_url /repository/ set exclude_package_list {} set channel_index_template [template::themed_template /packages/acs-admin/www/apm/repository-channel-index] set index_template [template::themed_template /packages/acs-admin/www/apm/repository-index] # # Make sure workdir exists. Clear it before we start if requested. # if {$force_fresh_p} { file delete -force -- $work_dir } file mkdir $work_dir #---------------------------------------------------------------------- # Prepare output #---------------------------------------------------------------------- ns_log Debug "Repository: Building Package Repository" #---------------------------------------------------------------------- # Find available channels #---------------------------------------------------------------------- # # The core repo is considered the source of truth concerning # available channels. We fetch it first. # apm_git_fetch_repo -path $work_dir -repo openacs-core set core_repo_dir ${work_dir}openacs-core # # Channels that exist both from tags and from branches will be # taken from tags. # # Among tags, the compat one will have precedence over the final # one. # set core_channels [list] foreach tag [apm_git_repo_tags -path $core_repo_dir] { if {[regexp {^openacs-(.*)-(final|compat)} $tag _ channel type]} { if {![dict exists $core_channels $channel] || $type eq "compat" } { dict set core_channels $channel $tag } } } # # The latest release branch is special. It will have precedence # over the corresponding tag: this way people will get a fresher # version. # set branches [lsort -dictionary [apm_git_repo_branches -path $core_repo_dir]] set latest_branch [lindex $branches end] foreach branch $branches { regsub {^oacs-} $branch {} channel if {![dict exists $core_channels $channel] || $branch eq $latest_branch } { dict set core_channels $channel $branch } } # # We don't want to generate a channel for ancient versions of # packages. Here we remove those channels that are too old. For # some old versions, we will only generate the compat packages. # foreach {channel branch} $core_channels { regsub -all -- - $channel {.} channel_version if {([regexp {^.*-final} $branch] && [apm_version_names_compare $channel_version $min_final_version] == -1) || [apm_version_names_compare $channel_version $min_compat_version] == -1 } { dict unset core_channels $channel } } # # The HEAD channel is always included. # lappend core_channels HEAD HEAD if {$debug_p} { # # When debugging, only pick the last branch. # set core_channels [lrange $core_channels end-1 end] } ns_log notice "Repository channels:" $core_channels # # The core packages are those included in the openacs-core # repository. # set core_packages_dir ${core_repo_dir}${sep}packages set core_packages [list] foreach package_folder [glob \ -types d \ -directory $core_packages_dir *] { lappend core_packages [file tail $package_folder] } ns_log notice "Core packages:" $core_packages set non_core_packages_dir ${work_dir}openacs-non-core${sep} file mkdir $non_core_packages_dir # # This is the list of all packages that are not included in the # openacs-core repository. We currently maintain this list as # hardcoded here. One improvement would be to fetch it from the # Git host directly, either via scraping or via API. # # As long as this does not change, every time a new package is # added to the Git mirror, one should also add the corresponding # package key to this list. # set non_core_packages { accounts-desk accounts-finance accounts-ledger accounts-payables accounts-payroll accounts-receivables acs-datetime acs-events acs-interface acs-ldap-authentication acs-mail acs-notification acs-object-management acs-object-management acs-outdated acs-person address-book adserver ae-portlet ajax-filestorage-ui ajax-photoalbum-ui ajaxhelper ams anon-eval application-track application-track-portlet assessment assessment-portlet attachments attendance auth-cas auth-http auth-ldap auth-pam auth-server authorize-gateway bboard-portlet beehive beehive-portlet bm-portlet bookmarks bookshelf boomerang bootstrap-icons bug-tracker bulk-mail caldav calendar calendar-includelet calendar-portlet captcha cards cards-portlet categories chat chat-includelet chat-portlet clickthrough clipboard cms cms-news-demo connections contacts contacts-lite contacts-portlet content-includelet content-portlet cookie-consent courses cronjob curriculum curriculum-central curriculum-portlet curriculum-tracker customer-service datamanager datamanager-portlet dbm diagram directory docker-s6 dotfolio dotfolio-ui dotkul dotkul-admin dotlrn dotlrn-admin dotlrn-ae dotlrn-application-track dotlrn-assessment dotlrn-attendance dotlrn-bboard dotlrn-beehive dotlrn-bm dotlrn-calendar dotlrn-cards dotlrn-catalog dotlrn-chat dotlrn-contacts dotlrn-content dotlrn-curriculum dotlrn-datamanager dotlrn-dotlrn dotlrn-ecommerce dotlrn-edit-this-page dotlrn-eduwiki dotlrn-evaluation dotlrn-expense-tracking dotlrn-faq dotlrn-forums dotlrn-fs dotlrn-glossar dotlrn-homework dotlrn-imsld dotlrn-invoices dotlrn-jabber dotlrn-lamsint dotlrn-latest dotlrn-learning-content dotlrn-lorsm dotlrn-messages dotlrn-mmplayer dotlrn-news dotlrn-news-aggregator dotlrn-photo-album dotlrn-portlet dotlrn-project-manager dotlrn-quota dotlrn-random-photo dotlrn-recruiting dotlrn-research dotlrn-static dotlrn-survey dotlrn-syllabus dotlrn-tasks dotlrn-user-tracking dotlrn-weblogger dotlrn-wikipedia dotlrn-wps dotlrn-xowiki dotlrndoc download dynamic-types ec-serial-numbers ecommerce edit-this-page edit-this-page-portlet eduwiki eduwiki-portlet email-handler evaluation evaluation-portlet expense-tracking expenses ezic-gateway fa-icons fabrik facebook-api faq faq-portlet feed-parser file-manager file-storage file-storage-includelet forums forums-includelet forums-portlet fs-portlet gatekeeper general-comments glossar glossar-portlet glossary highcharts image-magick ims-ent imsld imsld-portlet inventory-control invoices invoices-portlet jabber jabber-portlet lab-report lab-report-central lams-conf lamsint lamsint-portlet lars-blogger latest latest-portlet layout-managed-subsite layout-manager learning-content learning-content-portlet logger lors lors-central lorsm lorsm-includelet lorsm-portlet mail-tracking messages messages-portlet mmplayer mmplayer-portlet monitoring new-portal news news-aggregator news-aggregator-portlet news-includelet news-portlet notes oacs-dav oct-election online-catalog openacs-bootstrap3-theme openacs-bootstrap5-theme openfts-driver organizations package-builder page pages payflowpro payment-gateway photo-album photo-album-portlet places planner poll postal-address postcard press proctoring-support profile-provider project-manager project-manager-portlet quota quota-portlet random-photo-portlet ratings recruiting recruiting-portlet redirect ref-currency ref-gifi ref-itu ref-unspec ref-us-counties ref-us-states ref-us-zipcodes related-items research-portlet richtext-ckeditor4 richtext-ckeditor5 richtext-tinymce richtext-xinha robot-detection rss-support rules s5 sample-gateway schema-browser scholarship-fund scorm-core scorm-importer scorm-player scorm-simple-lms shipping-gateway shipping-tracking simple-survey simulation site-wide-search skin sloan-bboard soap-db soap-gateway spam spreadsheet static-pages static-portlet survey survey-builder-ui survey-library survey-portlet survey-reports t-account tasks tasks-portlet telecom-number theme-selva theme-zen timezones trackback tracker tsoap user-preferences user-profile user-tracking user-tracking-portlet value-based-shipping version-control views weblogger-portlet webmail webmail-system wiki wikipedia wikipedia-portlet workflow wp-slim wps-portlet xcms-ui xml-rpc xolp xooauth xotcl-core xotcl-request-monitor xowf xowf-monaco-plugin xowiki xowiki-includelet xowiki-portlet } if {$debug_p} { # # When debugging, pick only a subset of all packages. # set non_core_packages [lrange $non_core_packages 0 10] } foreach package_key $non_core_packages { apm_git_fetch_repo -path $non_core_packages_dir -repo $package_key } #---------------------------------------------------------------------- # Read all package .info files, building manifest file #---------------------------------------------------------------------- set update_pretty_date [lc_time_fmt [clock format [clock seconds] -format "%Y-%m-%d %T"] %c] foreach {channel branch} $core_channels { ns_log Notice "Repository: Channel $channel using branch $branch" # # Checkout the channel branch on the core repository. # apm_git_checkout_repo -path $core_repo_dir -branch $branch # # Try to check out the channel from the non-core packages. # set branch_packages [list] foreach package_key $non_core_packages { set package_dir ${non_core_packages_dir}${package_key} if {![file isdirectory $package_dir]} { ns_log notice "Package '$package_key' was not cloned in '$package_dir', skipping." continue } # # Not all packages will have a release branch. Skip the # package when the branch is not found. # if {$branch in [apm_git_repo_channels -path $package_dir]} { apm_git_checkout_repo -path $package_dir -branch $branch lappend branch_packages $package_key } } # # Now collect the info files for all core and non-core # packages belonging to this branch. # set info_files [list] foreach package_key $core_packages { if {[catch { set info_file [apm_package_info_file_path -path $core_packages_dir $package_key] } errmsg]} { ns_log warning "Cannot find an .info file on '$branch' for core package '$package_key':" $errmsg continue } lappend info_files $info_file } foreach package_key $branch_packages { if {[catch { set info_file [apm_package_info_file_path -path $non_core_packages_dir $package_key] } errmsg]} { ns_log warning "Cannot find an .info file on '$branch' for non.core package '$package_key':" $errmsg continue } lappend info_files $info_file } # Prepare channel directory set channel_dir "${work_dir}repository${sep}${channel}${sep}" file mkdir $channel_dir set manifest "<manifest>\n" template::multirow create packages \ package_path package_key version pretty_name \ package_type summary description \ release_date vendor_url vendor \ maturity maturity_text \ license license_url download_url set packages [list] foreach spec_file [lsort $info_files] { set package_path [file join {*}[lrange [file split $spec_file] 0 end-1]] set package_key [lindex [file split $spec_file] end-1] if { $package_key in $exclude_package_list } { ns_log Debug "Repository: Package $package_key is on list of packages to exclude - skipping" continue } unset -nocomplain pkg_info ad_try { array set pkg_info [apm_read_package_info_file $spec_file] if { $pkg_info(package.key) in $packages } { ns_log Debug "Repository: Skipping package $package_key, because we already have another version of it" } else { lappend packages $pkg_info(package.key) append manifest \ " <package>" \n \ " <package-key>[ns_quotehtml $pkg_info(package.key)]</package-key>\n" \ " <version>[ns_quotehtml $pkg_info(name)]</version>\n" \ " <pretty-name>[ns_quotehtml $pkg_info(package-name)]</pretty-name>\n" \ " <package-type>[ns_quotehtml $pkg_info(package.type)]</package-type>\n" \ " <summary>[ns_quotehtml $pkg_info(summary)]</summary>\n" \ " <description format=\"[ns_quotehtml $pkg_info(description.format)]\">" \ [ns_quotehtml $pkg_info(description)] "</description>\n" \ " <release-date>[ns_quotehtml $pkg_info(release-date)]</release-date>\n" \ " <vendor url=\"[ns_quotehtml $pkg_info(vendor.url)]\">" \ [ns_quotehtml $pkg_info(vendor)] "</vendor>\n" \ " <license url=\"[ns_quotehtml $pkg_info(license.url)]\">" \ [ns_quotehtml $pkg_info(license)] "</license>\n" \ " <maturity>$pkg_info(maturity)</maturity>\n" foreach e $pkg_info(install) { append manifest " <install package=\"$e\"/>\n" } set apm_file "${channel_dir}${pkg_info(package.key)}-${pkg_info(name)}.apm" ns_log Notice "Repository: Building package $package_key for channel $channel" set files [apm_get_package_files \ -all \ -include_data_model_files \ -all_db_types \ -package_key $pkg_info(package.key) \ -package_path $package_path] if { [llength $files] == 0 } { ns_log Notice "Repository: No files in package" } else { ns_log Notice "Repository: [llength $files] files in package $pkg_info(package.key) ($channel)" set cmd [list exec [apm_tar_cmd] cf - 2>/dev/null] # The path to the 'packages' directory in the checkout set packages_root_path [file join {*}[lrange [file split $spec_file] 0 end-2]] set fp [ad_opentmpfile tmp_filename] foreach file $files { puts $fp $package_key/$file } close $fp lappend cmd -C $packages_root_path --files-from $tmp_filename lappend cmd "|" [apm_gzip_cmd] -c ">" $apm_file ns_log Notice "Executing: exec $cd_helper $packages_root_path $cmd" if {[catch "exec $cd_helper $packages_root_path $cmd" errmsg]} { ns_log Error "Error during tar in repository creation for\ file ${channel_dir}$pkg_info(package.key)-$pkg_info(name).apm:\ \n$errmsg\n$::errorCode,$::errorInfo" } file delete -- $tmp_filename } set apm_url "${repository_url}$channel/$pkg_info(package.key)-$pkg_info(name).apm" template::multirow append packages \ $package_path $package_key $pkg_info(name) $pkg_info(package-name) \ $pkg_info(package.type) $pkg_info(summary) $pkg_info(description) \ $pkg_info(release-date) $pkg_info(vendor.url) $pkg_info(vendor) \ $pkg_info(maturity) $pkg_info(maturity_text) \ $pkg_info(license) $pkg_info(license.url) $apm_url append manifest " <download-url>$apm_url</download-url>\n" foreach elm $pkg_info(provides) { append manifest " <provides " \ "url=\"[ns_quotehtml [lindex $elm 0]]\" " \ "version=\"[ns_quotehtml [lindex $elm 1]]\" />\n" } foreach elm $pkg_info(requires) { append manifest " <requires " \ "url=\"[ns_quotehtml [lindex $elm 0]]\" " \ "version=\"[ns_quotehtml [lindex $elm 1]]\" />\n" } append manifest " </package>\n" } } on error {errorMsg} { ns_log Notice "Repository: Error on spec_file $spec_file: $errorMsg\n$::errorInfo\n" } } append manifest "</manifest>\n" ns_log Notice "Repository: Writing $channel manifest to ${channel_dir}manifest.xml" set fw [open "${channel_dir}manifest.xml" w] puts $fw $manifest close $fw ns_log Notice "Repository: Writing $channel index page to ${channel_dir}index.adp" set fw [open "${channel_dir}index.adp" w] set packages [lsort $packages] puts $fw "<master>\n<property name=\"doc(title)\">OpenACS $channel Compatible Packages</property>\n\n" puts $fw "<h1>OpenACS $channel (Git branch $branch)</h1> <p>Packages can be installed with the OpenACS Automated Installer on your OpenACS site at <code>/acs-admin/install</code>. Only packages potentially compatible with your OpenACS kernel will be shown.</p> " set category_title(core) "Core Packages" set package_keys(core) $core_packages set category_title(common-app) "Common Applications" set package_keys(common-app) { xowiki xotcl-request-monitor file-storage acs-developer-support forums calendar news faq } set category_title(extra) "Extra Packages and Libraries" set package_keys(extra) "" foreach p $packages { if {$p ni $package_keys(core) && $p ni $package_keys(common-app)} { lappend package_keys(extra) $p } } foreach category {core common-app extra} { template::multirow create pkgs \ package_path package_key version pretty_name \ package_type summary description \ release_date vendor_url vendor \ maturity maturity_text \ license license_url download_url template::multirow foreach packages { if {$package_key in $package_keys($category)} { template::multirow append pkgs \ $package_path $package_key $version $pretty_name \ $package_type $summary $description \ $release_date $vendor_url $vendor \ $maturity $maturity_text \ $license $license_url $download_url } } puts $fw "\n<h2>$category_title($category)</h2>\n" puts $fw [template::adp_include $channel_index_template \ [list channel $channel &pkgs pkgs update_pretty_date $update_pretty_date]] } close $fw ns_log Notice "Repository: Channel $channel complete." } ns_log Notice "Repository: Finishing Repository" foreach channel [dict keys $core_channels] { if {[regexp {^([1-9][0-9]*)-([0-9]+)$} $channel . major minor]} { # # *-compat channels: The "patchlevel" of these channels is # the highest possible value, higher than the released # -final channels. # set tag_order([format %.3d $major]-[format %.3d $minor]-999) $channel set tag_label($channel) "OpenACS $major.$minor" } elseif {[regexp {^([1-9][0-9]*)-([0-9]+)-([0-9]+)$} $channel . major minor patch]} { # # *-final channels: a concrete patchlevel is provided. # set tag_order([format %.3d $major]-[format %.3d $minor]-[format %.3d $patch]) $channel set tag_label($channel) "OpenACS $major.$minor.$patch" } else { set tag_order(999-999-999) $channel set tag_label($channel) "OpenACS $channel" } } # Write the index page ns_log Notice "Repository: Writing repository index page to ${work_dir}repository/index.adp" template::multirow create channels name tag label foreach key [lsort -decreasing [array names tag_order]] { set channel $tag_order($key) template::multirow append channels $channel [dict get $core_channels $channel] $tag_label($channel) } set fw [open "${work_dir}repository/index.adp" w] puts $fw "<master>\n<property name=\"doc(title)\">OpenACS Package Repository</property>\n\n" puts $fw [template::adp_include -- $index_template \ [list &channels channels update_pretty_date $update_pretty_date]] close $fw # Add a redirector for outdated releases set fw [open "${work_dir}repository/index.vuh" w] puts $fw "ns_returnredirect /repository/" close $fw # Without the trailing slash set work_repository_dirname "${work_dir}repository" set repository_dirname [string range $repository_dir 0 end-1] set repository_bak "[string range $repository_dir 0 end-1]_bak" ns_log Notice "Repository: Moving work repository $work_repository_dirname to live repository dir at <a href=\"/repository\/>$repository_dir</a>\n" if { [file exists $repository_bak] } { file delete -force -- $repository_bak } if { [file exists $repository_dirname] } { file rename -- $repository_dirname $repository_bak } file rename -- $work_repository_dirname $repository_dirname ns_log Debug "Repository: DONE" return 0 } # # Local variables: # mode: tcl # tcl-indent-level: 4 # indent-tabs-mode: nil # End: