[37805] branches/gsoc08-privileges/base/src/port1.0/portutil.tcl
pmagrath at macports.org
pmagrath at macports.org
Tue Jun 24 04:39:08 PDT 2008
Revision: 37805
http://trac.macosforge.org/projects/macports/changeset/37805
Author: pmagrath at macports.org
Date: 2008-06-24 04:39:08 -0700 (Tue, 24 Jun 2008)
Log Message:
-----------
Use $env(HOME) to get user home directory.
Modified Paths:
--------------
branches/gsoc08-privileges/base/src/port1.0/portutil.tcl
Modified: branches/gsoc08-privileges/base/src/port1.0/portutil.tcl
===================================================================
--- branches/gsoc08-privileges/base/src/port1.0/portutil.tcl 2008-06-24 11:05:02 UTC (rev 37804)
+++ branches/gsoc08-privileges/base/src/port1.0/portutil.tcl 2008-06-24 11:39:08 UTC (rev 37805)
@@ -1379,7 +1379,7 @@
# open file to store name of completed targets
proc open_statefile {args} {
global workpath worksymlink place_worksymlink portname portpath ports_ignore_older
- global altprefix macportsuser euid egid usealtworkpath
+ global altprefix macportsuser euid egid usealtworkpath env
# start gsoc08-privileges
@@ -1420,44 +1420,43 @@
ui_msg "Insufficient privileges to perform action for all users."
ui_msg "Action will be performed for current user only."
ui_msg "Install actions should be executed using sudo."
-
- #set usealtworkpath [gets stdin]
- set usealtworkpath yes
- } else {
- set usealtworkpath yes
- }
+ }
- if {$usealtworkpath} {
+ # set global variable indicating to other functions to use ~/.macports as well
+ set usealtworkpath yes
- # do tilde expansion manually - tcl won't expand tildes automatically for curl, etc.
- set userhome "/Users/[uid_to_name [getuid]]"
-
- # set alternative prefix global variables
- set altprefix "$userhome/.macports"
-
- # get alternative paths
- set newworkpath "$altprefix/[ string range $workpath 1 end ]"
- set newworksymlink "$altprefix/[ string range $worksymlink 1 end ]"
-
- set sourcepath [string map {"work" ""} $worksymlink]
- set newsourcepath "$altprefix/[ string range $sourcepath 1 end ]"
-
- # copy Portfile if not there already
- # note to self: should this be done always in case existing Portfile is out of date?
- if {![file exists ${newsourcepath}Portfile] } {
- file mkdir $newsourcepath
- ui_debug "$newsourcepath created"
- ui_debug "Going to copy: ${sourcepath}Portfile"
- file copy ${sourcepath}Portfile $newsourcepath
- }
-
- set workpath $newworkpath
- set worksymlink $newworksymlink
-
- ui_debug "Going to use $newworkpath for statefile."
+ # do tilde expansion manually - tcl won't expand tildes automatically for curl, etc.
+ if {[info exists env(HOME)]} {
+ # HOME evnironment var is set, use it.
+ set userhome "$env(HOME)"
} else {
- return -code error "Insufficient privileges."
+ # the environment var isn't set, make an educated guess
+ set userhome "/Users/[uid_to_name [getuid]]"
}
+
+ # set alternative prefix global variables
+ set altprefix "$userhome/.macports"
+
+ # get alternative paths
+ set newworkpath "$altprefix/[ string range $workpath 1 end ]"
+ set newworksymlink "$altprefix/[ string range $worksymlink 1 end ]"
+
+ set sourcepath [string map {"work" ""} $worksymlink]
+ set newsourcepath "$altprefix/[ string range $sourcepath 1 end ]"
+
+ # copy Portfile if not there already
+ # note to self: should this be done always in case existing Portfile is out of date?
+ if {![file exists ${newsourcepath}Portfile] } {
+ file mkdir $newsourcepath
+ ui_debug "$newsourcepath created"
+ ui_debug "Going to copy: ${sourcepath}Portfile"
+ file copy ${sourcepath}Portfile $newsourcepath
+ }
+
+ set workpath $newworkpath
+ set worksymlink $newworksymlink
+
+ ui_debug "Going to use $newworkpath for statefile."
}
# end gsoc08-privileges
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.macosforge.org/pipermail/macports-changes/attachments/20080624/d76fdc38/attachment.htm
More information about the macports-changes
mailing list