elevate rewrite
parent
7e00d6a357
commit
9f74361b7a
|
@ -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 } ;
|
|
@ -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? -- )
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue