os-specific refactor appears to work on Linux
Cat Stevens
Doug Coleman
parent
3e5a600698
commit
eda9bcb839
|
|
@ -1,99 +1,34 @@
|
|||
USING: accessors arrays assocs command-line environment
|
||||
formatting fry io.launcher kernel ui locals math namespaces
|
||||
sequences splitting strings system unix.ffi unix.process ;
|
||||
USING: accessors arrays assocs combinators command-line
|
||||
environment formatting fry io.launcher kernel locals math
|
||||
namespaces sequences splitting strings system ui vocabs ;
|
||||
IN: elevate
|
||||
|
||||
<PRIVATE
|
||||
ERROR: elevated-failed command { strategies array } ;
|
||||
ERROR: lowered-failed ;
|
||||
|
||||
CONSTANT: apple-script-charmap H{
|
||||
{ "\n" "\\n" }
|
||||
{ "\r" "\\r" }
|
||||
{ "\t" "\\t" }
|
||||
{ "\"" "\\\"" }
|
||||
{ "\\" "\\\\" }
|
||||
}
|
||||
GENERIC#: prepend-command 1 ( command word -- word+command )
|
||||
M: array prepend-command
|
||||
prefix ;
|
||||
|
||||
: quote-apple-script ( str -- str' )
|
||||
[ 1string [ apple-script-charmap at ] [ ] bi or ] { } map-as
|
||||
"" join "\"" dup surround ;
|
||||
|
||||
: run-apple-script ( str -- ) drop ;
|
||||
|
||||
: apple-script-elevated ( command -- )
|
||||
quote-apple-script
|
||||
"do shell script %s with administrator privileges without altering line endings"
|
||||
sprintf run-apple-script ;
|
||||
|
||||
: posix-replace-process ( command-list -- code )
|
||||
[ first ] [ rest ] bi exec-with-path ;
|
||||
|
||||
: already-root? ( -- ? )
|
||||
getuid geteuid [ zero? ] bi@ or ;
|
||||
|
||||
GENERIC: glue-command ( prefix command -- glued )
|
||||
|
||||
M: array glue-command
|
||||
swap prefix ;
|
||||
|
||||
M: string glue-command
|
||||
" " glue ;
|
||||
M: string prepend-command
|
||||
swap " " glue ;
|
||||
|
||||
GENERIC: failed-process? ( process -- ? )
|
||||
M: f failed-process? not ;
|
||||
M: fixnum failed-process? -1 = ;
|
||||
M: process failed-process? status>> zero? not ;
|
||||
|
||||
: posix-lowered ( -- )
|
||||
getgid setgid failed-process? [ lowered-failed ] [ ] if
|
||||
getuid setuid failed-process? [ lowered-failed ] [ ] if ;
|
||||
|
||||
PRIVATE>
|
||||
HOOK: already-root? os ( -- ? )
|
||||
|
||||
HOOK: elevated os ( command replace? win-console? posix-graphical? -- process )
|
||||
|
||||
! TODO
|
||||
M: windows elevated
|
||||
3drop run-process ;
|
||||
|
||||
! TODO
|
||||
M:: macosx elevated ( command replace? win-console? posix-graphical? -- process )
|
||||
already-root? [ <process> command >>command 1array ] [
|
||||
posix-graphical? [ ! graphical (through applescript)
|
||||
command apple-script-elevated
|
||||
] when
|
||||
command replace? win-console? posix-graphical?
|
||||
linux os [ elevated ] with-variable
|
||||
] if ;
|
||||
|
||||
M:: linux elevated ( command replace? win-console? posix-graphical? -- process )
|
||||
already-root? [
|
||||
<process> command >>command 1array ! we are already root: just give a process
|
||||
] [
|
||||
! graphical handled
|
||||
posix-graphical? ui-running? or "DISPLAY" os-env and
|
||||
{ "gksudo" "kdesudo" "sudo" } { "sudo" } ?
|
||||
|
||||
command '[ _ glue-command ] map :> command-list command-list [
|
||||
replace? [
|
||||
" " split posix-replace-process
|
||||
] [ run-process ] if
|
||||
] map
|
||||
! if they all failed, then it failed, but if one passed, that's normal (success)
|
||||
[ [ failed-process? ] all? [ command command-list elevated-failed ] [ ] if ] keep
|
||||
] if ;
|
||||
HOOK: lowered os ( -- )
|
||||
|
||||
: elevate ( win-console? posix-graphical? -- ) [ (command-line) t ] 2dip elevated drop ;
|
||||
|
||||
HOOK: lowered os ( -- )
|
||||
|
||||
! https://wiki.sei.cmu.edu/confluence/display/c/POS36-C.+Observe+correct+revocation+order+while+relinquishing+privileges
|
||||
! group ID must be lowered before user ID otherwise program may re-gain root!
|
||||
M: linux lowered
|
||||
posix-lowered ;
|
||||
|
||||
M: macosx lowered
|
||||
posix-lowered ;
|
||||
|
||||
M: windows lowered ;
|
||||
{
|
||||
{ [ os windows? ] [ "elevate.windows" require ] }
|
||||
{ [ os linux? ] [ "elevate.linux" require ] }
|
||||
{ [ os macosx? ] [ "elevate.macosx" require ] }
|
||||
} cond
|
||||
|
|
|
|||
|
|
@ -0,0 +1,34 @@
|
|||
USING: accessors arrays elevate elevate.private elevate.unix
|
||||
elevate.unix.private environment io.launcher kernel locals
|
||||
sequences system ui ;
|
||||
IN: elevate.linux
|
||||
|
||||
<PRIVATE
|
||||
M:: linux elevated ( command replace? win-console? posix-graphical? -- process )
|
||||
already-root? [
|
||||
<process> command >>command 1array ! we are already root: just give a process
|
||||
] [
|
||||
posix-graphical? ui-running? or "DISPLAY" os-env and [
|
||||
command { "gksudo" "kdesudo" "pkexec" "sudo" } [
|
||||
prepend-command
|
||||
] with map :> command-list
|
||||
|
||||
command-list [
|
||||
replace? [ posix-replace-process ] [
|
||||
! need to fix race condition
|
||||
<process> swap >>command t >>detached run-process
|
||||
] if
|
||||
] map [
|
||||
[ failed-process? ] all? [
|
||||
command command-list elevated-failed
|
||||
] [ ] if
|
||||
] keep
|
||||
] [
|
||||
command replace? posix-elevated ! sudo only
|
||||
] if
|
||||
] if ;
|
||||
|
||||
M: linux lowered
|
||||
posix-lowered ;
|
||||
|
||||
PRIVATE>
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
USING: cocoa.apple-script elevate elevate.unix ;
|
||||
IN: elevate.macosx
|
||||
|
||||
<PRIVATE
|
||||
CONSTANT: apple-script-charmap H{
|
||||
{ "\n" "\\n" }
|
||||
{ "\r" "\\r" }
|
||||
{ "\t" "\\t" }
|
||||
{ "\"" "\\\"" }
|
||||
{ "\\" "\\\\" }
|
||||
}
|
||||
|
||||
: quote-apple-script ( str -- str' )
|
||||
[ 1string [ apple-script-charmap at ] [ ] bi or ] { } map-as
|
||||
"" join "\"" dup surround ;
|
||||
|
||||
: apple-script-elevated ( command -- )
|
||||
quote-apple-script
|
||||
"do shell script %s with administrator privileges without altering line endings"
|
||||
sprintf run-apple-script ;
|
||||
|
||||
! TODO
|
||||
M:: macosx elevated ( command replace? win-console? posix-graphical? -- process )
|
||||
already-root? [ <process> command >>command 1array ] [
|
||||
posix-graphical? [ ! graphical through applescript
|
||||
command apple-script-elevated
|
||||
] when
|
||||
posix-elevated
|
||||
] if ;
|
||||
|
||||
M: macosx lowered
|
||||
posix-lowered ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
USING: arrays elevate elevate.private io.launcher kernel locals
|
||||
math sequences splitting strings system unix.ffi unix.process prettyprint ;
|
||||
IN: elevate.unix
|
||||
|
||||
<PRIVATE
|
||||
! https://wiki.sei.cmu.edu/confluence/x/p9YxBQ
|
||||
! group ID must be lowered before user ID otherwise program may re-gain root!
|
||||
: posix-lowered ( -- )
|
||||
getgid setgid failed-process? [ lowered-failed ] [ ] if
|
||||
getuid setuid failed-process? [ lowered-failed ] [ ] if ;
|
||||
|
||||
GENERIC: posix-replace-process ( command-list -- code )
|
||||
! naive split breaks with spaces inside quotes in shell commands
|
||||
M: string posix-replace-process
|
||||
" " split posix-replace-process ;
|
||||
M: array posix-replace-process
|
||||
[ first ] [ rest " " prefix ] bi exec-with-path ;
|
||||
|
||||
! if either the real or effective user IDs are 0, we are already elevated
|
||||
M: unix already-root?
|
||||
getuid geteuid [ zero? ] bi@ or ;
|
||||
|
||||
:: posix-elevated ( command replace? -- process )
|
||||
command "sudo" prepend-command
|
||||
replace? [ posix-replace-process ] [ run-process ] if
|
||||
dup failed-process? [ drop command { "sudo" } elevated-failed ] [ ] if ;
|
||||
|
||||
M: unix elevated
|
||||
2drop posix-elevated ;
|
||||
|
||||
PRIVATE>
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
USING: io.launcher elevate ;
|
||||
IN: elevate.windows
|
||||
|
||||
|
||||
<PRIVATE
|
||||
! TODO
|
||||
M: windows elevated
|
||||
3drop run-process ;
|
||||
|
||||
! no-op (not possible to lower)
|
||||
M: windows lowered ;
|
||||
PRIVATE>
|
||||
Loading…
Reference in New Issue