move main logic into goa namespace

This reduces the use of global variables and renders bin/goa easier to
grasp. Moreover, this change paves the way for eliminating config variables
from the global namespace without the need to adapt every line that uses
such a variable. Within procedures, we can easily import namespace
variables.

#99

share/goa/lib/actions/generic.tcl

@@ -0,0 +1,147 @@
+##
+# Generic actions that do not require a project directory
+#
+
+namespace eval goa {
+	namespace ensemble create
+
+	namespace export help update depot-dir add-depot-user
+
+	##
+	# implements 'goa help'
+	#
+	proc help { help_topic } {
+
+		global   tool_dir
+
+		set file [file join $tool_dir doc $help_topic.txt]
+		if {![file exists $file]} {
+			set topics [glob -directory [file join $tool_dir doc] -tail *.txt]
+			regsub -all {.txt} $topics "" topics
+			exit_with_error "help topic '$help_topic' does not exist\n"\
+			                "\n Available topics are: [join $topics {, }]\n"
+		}
+		set     cmd [file join $tool_dir gosh gosh]
+		lappend cmd --style man $file | man -l -
+		spawn -noecho sh -c "$cmd"
+		interact
+	}
+
+	##
+	# implements 'goa update-goa'
+	#
+	proc update { branch } {
+
+		global   tool_dir
+
+		set status [exec git -C [file dirname [file dirname $tool_dir]] status -s]
+		if {$status != ""} {
+			exit_with_error "aborting Goa update because it was changed locally\n\n$status" }
+
+		if {[catch { goa_git fetch origin } msg]} {
+			exit_with_error "Goa update could not fetch new version:\n$msg" }
+
+		if {$branch != ""} {
+
+			set remote_branches [avail_goa_branches]
+
+			if {[lsearch $remote_branches $branch] == -1} {
+				exit_with_error "Goa version $branch does not exist\n" \
+				                "\n Available versions are: [join $remote_branches {, }]\n"
+			}
+
+			set git_branch_output [goa_git branch | sed "s/^..//"]
+			set local_branches [split $git_branch_output "\n"]
+
+			if {[lsearch $local_branches $branch] == -1} {
+				goa_git checkout -q -b $branch origin/$branch
+			} else {
+				goa_git checkout -q $branch
+			}
+		}
+
+		goa_git merge --ff-only origin/[current_goa_branch]
+	}
+
+
+	##
+	# Return 1 if depot_dir exists
+	#
+	proc _depot_exists { } {
+
+		global depot_dir
+		return [expr {[file exists $depot_dir] && [file isdirectory $depot_dir]}]
+	}
+
+
+	##
+	# Set writeable permission for specified path and its subdirectories
+	#
+	proc _make_writeable { path } {
+
+		file attributes $path -permissions "+w"
+		if {[file isdirectory $path]} {
+			foreach entry [glob [file join $path "*"]] {
+				_make_writeable $entry } }
+	}
+
+	##
+	# Implements 'goa depot-dir'
+	#
+	proc depot-dir { } {
+
+		global tool_dir
+		global depot_dir
+
+		# create default depot
+		if {![_depot_exists]} {
+			file mkdir [file dirname $depot_dir]
+			file copy [file join $tool_dir default_depot] $depot_dir
+			_make_writeable $depot_dir
+		}
+	}
+
+	##
+	# Implements 'goa add-depot-user'
+	#
+	proc add-depot-user { new_depot_user depot_url pubkey_file gpg_user_id } {
+
+		global depot_dir
+
+		set policy [depot_policy]
+
+		set new_depot_user_dir [file join $depot_dir $new_depot_user]
+		if {[file exists $new_depot_user_dir]} {
+			if {$policy == "overwrite"} {
+				file delete -force $new_depot_user_dir
+			} elseif {$policy == "retain"} {
+				log "depot user directory $new_depot_user_dir already exists"
+				return
+			} else {
+				exit_with_error "depot user directory $new_depot_user_dir already exists\n" \
+				                 "\n You may specify '--depot-overwrite' to replace" \
+				                 "or '--depot-retain' to keep the existing directory.\n"
+			}
+		}
+
+		file mkdir $new_depot_user_dir
+
+		set fh [open [file join $new_depot_user_dir download] "WRONLY CREAT TRUNC"]
+		puts $fh $depot_url
+		close $fh
+
+		set new_pubkey_file [file join $new_depot_user_dir pubkey]
+
+		if {$pubkey_file != ""} {
+			file copy $pubkey_file $new_pubkey_file }
+
+		if {$gpg_user_id != ""} {
+			exit_if_not_installed gpg
+			if {[catch { exec gpg --armor --export $gpg_user_id > $new_pubkey_file } msg]} {
+				file delete -force $new_depot_user_dir
+				exit_with_error "exporting the public key from the GPG keyring failed\n$msg"
+			}
+		}
+	}
+
+}

share/goa/lib/actions/import.tcl

@@ -0,0 +1,142 @@
+##
+# Import action and helpers
+#
+
+namespace eval goa {
+	namespace export import diff
+
+	proc calc_import_hash { } {
+
+		global tool_dir project_dir
+
+		set     cmd "make"
+		lappend cmd "-f" [file join $tool_dir ports mk print_hash.mk]
+		lappend cmd "-s"
+		lappend cmd "PORT=[file join $project_dir import]"
+		lappend cmd "REP_DIR=$project_dir"
+		lappend cmd "PORTS_TOOL_DIR=[file join $tool_dir ports]"
+
+		return [exec {*}$cmd]
+	}
+
+
+	##
+	# Return 1 if the specified src/ or raw/ sub directory contains local changes
+	#
+	proc check_modified { subdir } {
+
+		global contrib_dir
+
+		set dir_a [file join $contrib_dir $subdir]
+		set dir_b [file join $subdir]
+
+		if {![file exists $dir_a] || ![file isdirectory $dir_a]} { return 0 }
+		if {![file exists $dir_b] || ![file isdirectory $dir_b]} { return 0 }
+
+		return [catch {
+			exec -ignorestderr diff -u -r --exclude=.git --exclude=*~ $dir_a $dir_b
+		}]
+	}
+
+
+	##
+	# Diff between originally imported contrib code and local edits
+	#
+	proc diff { subdir } {
+		global contrib_dir
+
+		set dir_a [file join $contrib_dir $subdir]
+		set dir_b [file join $subdir]
+
+		if {![file exists $dir_a] || ![file isdirectory $dir_a]} { return }
+		if {![file exists $dir_b] || ![file isdirectory $dir_b]} { return }
+
+		catch {
+			#
+			# Filter the diff output via tail to strip the first two lines from the
+			# output. Those lines would show the diff command and the absolute path
+			# to 'contrib_dir'.
+			#
+			# The argument -N is specified o show the content new files.
+			#
+			exec -ignorestderr diff -N -u -r --exclude=.git --exclude=*~ $dir_a $dir_b \
+			                   | tail -n +3 >@ stdout
+		}
+	}
+
+
+	##
+	# Implements 'goa import'
+	#
+	proc import { } {
+
+		global contrib_dir verbose jobs project_dir build_dir tool_dir import_dir
+
+		if {![file exists import] || ![file isfile import]} {
+			exit_with_error "missing 'import' file" }
+
+		# quick-check the import.hash to detect the need for re-import
+		set need_fresh_import 0
+		set existing_hash [read_file_content_as_list [file join $contrib_dir import.hash]]
+
+		if {$existing_hash != [calc_import_hash]} {
+			set need_fresh_import 1 }
+
+		if {$need_fresh_import} {
+
+			# abort import if there are local changes in src/ or raw/
+			foreach subdir [list src raw] {
+				if {[check_modified $subdir]} {
+					exit_with_error "$subdir/ contains local changes," \
+					                 "review via 'goa diff'" } }
+
+			if {[file exists $contrib_dir]} {
+				file delete -force $contrib_dir }
+
+			file mkdir $contrib_dir
+
+			set     cmd "make"
+			lappend cmd "-f" [file join $tool_dir ports mk install.mk]
+			lappend cmd "-C" $contrib_dir
+			lappend cmd "-j$jobs"
+			lappend cmd "-s"
+			lappend cmd "PORT=[file join $project_dir import]"
+			lappend cmd "REP_DIR=$project_dir"
+			lappend cmd "PORTS_TOOL_DIR=[file join $tool_dir ports]"
+			lappend cmd "GENODE_CONTRIB_CACHE=$import_dir"
+
+			if {$verbose} {
+				lappend cmd "VERBOSE=" }
+
+			diag "import via command: $cmd"
+
+			if {[catch { exec {*}$cmd >@ stdout 2>@ stdout }]} {
+				exit_with_error "import failed" }
+
+			foreach subdir [list src raw] {
+
+				set src_dir [file join $contrib_dir $subdir]
+				set dst_dir [file join $project_dir $subdir]
+
+				if {[file exists $src_dir] && [file exists $dst_dir]} {
+					file delete -force $dst_dir }
+
+				if {[file exists $src_dir]} {
+					file copy -force $src_dir $dst_dir }
+			}
+
+			file delete -force $build_dir
+
+		} else {
+
+			foreach subdir [list src raw] {
+
+				set src_dir [file join $contrib_dir $subdir]
+				set dst_dir [file join $project_dir $subdir]
+
+				if {[file exists $src_dir] && ![file exists $dst_dir]} {
+					file copy -force $src_dir $dst_dir }
+			}
+		}
+	}
+}

share/goa/lib/actions/run.tcl

@@ -0,0 +1,101 @@
+##
+# Run action and helpers
+#
+
+namespace eval goa {
+	namespace export run-dir
+
+	#
+	# set roms found in depot runtime files
+	#
+	proc update_depot_roms { archive_list &rom_modules } {
+
+		global depot_dir
+		upvar  ${&rom_modules} rom_modules
+
+		# append rom modules of runtimes
+		foreach runtime_file [runtime_files [apply_versions $archive_list]] {
+			append rom_modules " " [query_attrs_from_file /runtime/content/rom label $runtime_file]
+		}
+	}
+
+
+	proc run-dir { } {
+
+		global tool_dir project_dir run_pkg run_dir dbg_dir bin_dir depot_dir
+		global debug
+
+		set pkg_dir [file join $project_dir pkg $run_pkg]
+
+		if {![file exists $pkg_dir]} {
+			exit_with_error "no runtime defined at $pkg_dir" }
+
+		# install depot content needed according to the pkg's archives definition
+		set archives_file [file join $pkg_dir archives]
+		set runtime_archives [read_file_content_as_list $archives_file]
+
+		# init empty run directory
+		if {[file exists $run_dir]} {
+			file delete -force $run_dir }
+		file mkdir $run_dir
+
+		if { $debug } {
+			file mkdir [file join $run_dir .debug] }
+
+		#
+		# Generate Genode config depending on the pkg runtime specification. The
+		# procedure may extend the lists of 'runtime_archives' and 'rom_modules'.
+		#
+		set runtime_file [file join $pkg_dir runtime]
+
+		if {![file exists $runtime_file]} {
+			exit_with_error "missing runtime configuration at: $runtime_file" }
+
+		# check XML syntax of runtime config and config file at raw/
+		check_xml_syntax $runtime_file
+		foreach config_file [glob -nocomplain [file join raw *.config]] {
+			check_xml_syntax $config_file }
+
+		#
+		# Partially prepare depot before calling 'generate_runtime_config'.
+		# For plausability checks, the latter needs access to the included ROM modules.
+		#
+		set binary_archives [binary_archives [apply_versions $runtime_archives]]
+		prepare_depot_with_archives $binary_archives
+
+		set rom_modules { }
+		generate_runtime_config $runtime_file runtime_archives rom_modules
+
+		# prepare depot with additional archives added by 'generate_runtime_config'
+		set binary_archives [binary_archives [apply_versions $runtime_archives]]
+		prepare_depot_with_archives $binary_archives
+		if { $debug } {
+			prepare_depot_with_debug_archives $binary_archives }
+
+		update_depot_roms $runtime_archives rom_modules
+
+		# update 'binary_archives' with information available after installation
+		set binary_archives [binary_archives [apply_versions $runtime_archives]]
+
+		set debug_modules [lmap x $rom_modules {expr { "$x.debug" }}]
+
+		# populate run directory with depot content
+		foreach archive $binary_archives {
+			symlink_directory_content $rom_modules [file join $depot_dir $archive] $run_dir
+
+			# add debug info files
+			if { $debug && [regsub {/bin/} $archive {/dbg/} debug_archive] } {
+				symlink_directory_content $debug_modules [file join $depot_dir $debug_archive] [file join $run_dir .debug] }
+		}
+
+		# add artifacts as extracted from the build directory
+		symlink_directory_content $rom_modules $bin_dir $run_dir
+
+		# add debug info files as extracted from the build directory
+		symlink_directory_content $debug_modules $dbg_dir [file join $run_dir .debug]
+
+		# add content found in the project's raw/ subdirectory
+		symlink_directory_content $rom_modules [file join $project_dir raw] $run_dir
+
+	}
+}