fix bugs and add docs

elevate-erg
Cat Stevens 2018-05-18 19:46:03 -04:00 committed by Doug Coleman
parent fafdef3138
commit 3e5a600698
2 changed files with 59 additions and 18 deletions

View File

@ -1,12 +1,45 @@
USING: arrays help.markup help.syntax strings ;
USING: arrays elevate.private help.markup help.syntax
io.launcher kernel strings system ;
IN: elevate
ABOUT: elevate
ARTICLE: "elevate" "Cross-platform API for elevated permissions"
"Thanks to " { $url "https://github.com/barneygale/elevate" }
ARTICLE: "elevate" "Elevated permissions API"
"Ported from " { $url "https://github.com/barneygale/elevate" "Barney Gale's implementation" } " in Python."
{ $subsections elevate elevated lowered }
;
HELP: elevated
{ $values { "command" { $or array string } } }
{ $description } ;
{ $values { "command" { $or array string } } { "replace?" boolean } { "win-console?" boolean } { "posix-graphical" boolean } }
{ $description
"Spawn a process from the command " { $snippet "command" } " with superuser (administrator) privileges. If the calling process does not already have superuser privileges, it will request them by a number of platform-specific methods."
$nl
"If " { $snippet "replace?" } " is " { $link t } ", the calling Factor process will be replaced with the command (but see Notes)."
$nl
"Windows-specific: If " { $snippet "win-console?" } " is " { $link t } ", a new console window will " { $emphasis "always" } " be spawned for the resulting process, regardless of " { $snippet "replace?" } "."
$nl
"Mac and Linux-specific: If " { $snippet "posix-graphical?" } " is " { $link t } ", a graphical password method will be attempted before " { $snippet "sudo" } "."
$nl
"If the calling process is already run as superuser, nothing happens. The input command is left on the stack, placed into a "{ $link process } " inside an "{ $link array } "."
}
{ $notes
{ $list
{ "On Windows, " { $snippet "replace?" } " has the effect of killing (with " { $link exit } ") the calling process after spawning the command because there is no " { $snippet "exec" } " equivalent in Windows." }
}
}
{ $errors
{ $link elevated-failed } " when all strategies fail."
$nl
"Any errors thrown by " { $link run-process } "."
} ;
HELP: elevate
{ $values { "win-console?" boolean } { "posix-graphical" boolean } }
{ $description "Relaunch the current Factor process with superuser privileges. See " { $link elevated } " for an explanation, as the semantics are identical." } ;
HELP: lowered
{ $description "Give up all superuser rights, returning a process to normal userspace."
{ $notes "If the process is running as \"real superuser\", (not an impersonation), nothing happens." $nl "If the process is running as an unprivileged user, nothing happens." }
}
{ $errors { $link lowered-failed } " when giving up superuser rights failed." } ;

View File

@ -4,7 +4,7 @@ sequences splitting strings system unix.ffi unix.process ;
IN: elevate
<PRIVATE
ERROR: elevated-failed path ;
ERROR: elevated-failed command { strategies array } ;
ERROR: lowered-failed ;
CONSTANT: apple-script-charmap H{
@ -29,6 +29,9 @@ CONSTANT: apple-script-charmap H{
: 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
@ -42,6 +45,10 @@ 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: elevated os ( command replace? win-console? posix-graphical? -- process )
@ -52,27 +59,29 @@ M: windows elevated
! TODO
M:: macosx elevated ( command replace? win-console? posix-graphical? -- process )
posix-graphical? [ ! graphical (through applescript)
command apple-script-elevated
] when
command replace? win-console? posix-graphical?
linux os [ elevated ] with-variable ;
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 )
getuid zero? [
<process> command >>command ! we are already root: just give a 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 '[ _ 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 elevated-failed ] [ ] if ] keep
[ [ failed-process? ] all? [ command command-list elevated-failed ] [ ] if ] keep
] if ;
: elevate ( win-console? posix-graphical? -- ) [ (command-line) t ] 2dip elevated drop ;
@ -82,10 +91,9 @@ 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
getgid setgid failed-process? [ lowered-failed ] [ ] if
getuid setuid failed-process? [ lowered-failed ] [ ] if ;
posix-lowered ;
M: macosx lowered
linux os [ lowered ] with-variable ;
posix-lowered ;
M: windows lowered ;