elevate rewrite

elevate-erg
Cat Stevens 2018-05-18 12:08:24 -04:00 committed by Doug Coleman
parent 7e00d6a357
commit 9f74361b7a
2 changed files with 34 additions and 18 deletions

View File

@ -4,5 +4,9 @@ IN: elevate
ABOUT: elevate ABOUT: elevate
ARTICLE: "elevate" "Cross-platform API for elevated permissions" ARTICLE: "elevate" "Cross-platform API for elevated permissions"
"Thanks to " { $url "https://github.com/barneygales/elevate" } "Thanks to " { $url "https://github.com/barneygale/elevate" }
; ;
HELP: elevated
{ $values { "command" { $or array string } } }
{ $description } ;

View File

@ -2,29 +2,41 @@ USING: arrays command-line fry io.launcher kernel math namespaces
sequences system unix.ffi ; sequences system unix.ffi ;
IN: elevate IN: elevate
: apple-script-elevate ( x x -- ) 2drop ; : apple-script-elevate ( command -- ) 2drop ;
HOOK: elevate os ( win-console? posix-graphical? -- ) GENERIC: glue-command ( prefix command -- glued )
M: windows elevate 2drop ; M: array glue-command
swap prefix ;
M: macosx elevate M: string glue-command
[ ! graphical (through applescript) " " glue ;
t apple-script-elevate
ERROR: elevated-failed path ;
HOOK: elevated os ( command win-console? posix-graphical? -- process )
M: windows elevated
2drop run-process ;
M: macosx elevated
nip [ ! graphical (through applescript)
apple-script-elevate
] [ ] [
f linux os [ elevate ] with-variable f f linux os [ elevated ] with-variable
] if ; ] if ;
M: linux elevate M: linux elevated
getuid zero? [ nip getuid zero? [
2drop ! we are already root: do nothing drop ! we are already root: do nothing
] [ ] [
! graphical on linuxes { "gksudo" "kdesudo" "sudo" } { "sudo" } ? ! graphical handled
nip [ { "gksudo" "kdesudo" } ] [ { } ] if swap '[ _ glue-command ] map
"sudo" suffix (command-line) '[ 1array _ append ] map [ " " split [ first utf8 string>alien ] [ rest ] execvp ] map
[ [ -1 = ] all? elevated-failed
run-process drop
] each
] if ; ] if ;
HOOK: lower os ( relaunch? -- ) : elevate ( option? -- ) (command-line) elevated ;
HOOK: lowered os ( relaunch? -- )