Compare commits
14 Commits
master
...
elevate-er
Author | SHA1 | Date |
---|---|---|
|
e39a23dc96 | |
|
281165d7e7 | |
|
628d75e410 | |
|
147407a291 | |
|
a34a68cb06 | |
|
0422ea6b08 | |
|
56d2435aeb | |
|
3e6287629f | |
|
889f82e2e4 | |
|
eda9bcb839 | |
|
3e5a600698 | |
|
fafdef3138 | |
|
9f74361b7a | |
|
7e00d6a357 |
basis
cocoa/apple-script
|
@ -1,7 +1,10 @@
|
|||
USING: help.markup help.syntax strings ;
|
||||
|
||||
IN: cocoa.apple-script
|
||||
|
||||
HELP: quote-apple-script
|
||||
{ $values { "str" string } }
|
||||
{ $description "Escape special characters in a string to make it suitable as a literal string in AppleScript code." } ;
|
||||
|
||||
HELP: run-apple-script
|
||||
{ $values { "str" string } }
|
||||
{ $description "Runs the provided uncompiled AppleScript code." }
|
||||
|
|
|
@ -0,0 +1,10 @@
|
|||
USING: tools.test ;
|
||||
IN: cocoa.apple-script
|
||||
|
||||
{ "\\\\" } [ "\\" quote-apple-script ] unit-test
|
||||
{ "hello\\nthere" } [ "hello
|
||||
there" quote-apple-script ] unit-test ! no space, just a newline
|
||||
{ "hello\\rthere" } [ "hello\rthere" quote-apple-script ] unit-test
|
||||
{ "hello\\tthere" } [ "hello\tthere" quote-apple-script ] unit-test
|
||||
{ "hello\\tthere" } [ "hello there" quote-apple-script ] unit-test ! actual tab character 0x09
|
||||
|
|
@ -1,11 +1,23 @@
|
|||
! Copyright (C) 2013 John Benediktsson
|
||||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: cocoa cocoa.application cocoa.classes kernel parser
|
||||
multiline words ;
|
||||
|
||||
USING: assocs cocoa cocoa.application cocoa.classes kernel
|
||||
multiline parser sequences strings words ;
|
||||
IN: cocoa.apple-script
|
||||
|
||||
<PRIVATE
|
||||
CONSTANT: apple-script-charmap H{
|
||||
{ "\n" "\\n" }
|
||||
{ "\r" "\\r" }
|
||||
{ "\t" "\\t" }
|
||||
{ "\"" "\\\"" }
|
||||
{ "\\" "\\\\" }
|
||||
}
|
||||
PRIVATE>
|
||||
|
||||
: quote-apple-script ( str -- str' )
|
||||
[ 1string apple-script-charmap ?at drop ] { } map-as
|
||||
"" concat-as "\"" dup surround ;
|
||||
|
||||
: run-apple-script ( str -- )
|
||||
[ NSAppleScript -> alloc ] dip
|
||||
<NSString> -> initWithSource: -> autorelease
|
||||
|
|
|
@ -0,0 +1,2 @@
|
|||
Cat Stevens
|
||||
Barney Gale
|
|
@ -0,0 +1,82 @@
|
|||
USING: arrays elevate elevate.private help.markup help.syntax
|
||||
io.launcher kernel sequences strings system words ;
|
||||
IN: elevate
|
||||
|
||||
<PRIVATE
|
||||
: $resolve? ( children -- )
|
||||
first2 2dup swap lookup-word dup word? [ 2nip ($link) ] [ drop ":" glue $snippet ] if ;
|
||||
PRIVATE>
|
||||
|
||||
ABOUT: "elevate"
|
||||
|
||||
ARTICLE: "elevate" "Elevated permissions API"
|
||||
"The " { $vocab-link "elevate" } " vocabulary provides abstractions for running programs with elevated (administrator) privileges (permissions). It allows code to relaunch itself or other programs with administrator privileges after requiring a password."
|
||||
$nl
|
||||
"This vocabulary is inspired by and ported from " { $url "https://github.com/barneygale/elevate" "Barney Gale's elevate.py" } "."
|
||||
$nl
|
||||
{ $subsections already-root? elevate elevated lowered }
|
||||
"However, there are many caveats: " { $link "elevate.bugs" } "." ;
|
||||
|
||||
ARTICLE: "elevate.bugs" "Elevate bugs and caveats"
|
||||
"There are many inherent platform-specific limitations and workarounds in the " { $vocab-link "elevate" } " elevated privileges API. This article explains and documents them for the curious, future maintainers, or those who run into problems."
|
||||
{ $heading "macOS" }
|
||||
"On Apple macOS, an Applescript command is attempted for a graphical method before " { $snippet "sudo" } ". Sometimes, this command appears to execute incorrectly due to the group of the user owning the calling process. On macOS, " { $snippet "sudo" } " suffers the drawback mentioned below for applications which do not have a TTY connected."
|
||||
{ $heading "Linux, *BSD and other Unix-likes" }
|
||||
"On Linux, " { $snippet "gksudo" } ", " { $snippet "kdesudo" } ", and " { $snippet "pkexec" } " are all attempted graphical methods before " { $snippet "sudo" } "."
|
||||
{ $list
|
||||
{ { $snippet "pkexec" } " is the preferred and most secure graphical authentication method on Linux. It is undesirable for Factor applications, because unless a certain rare global registry value is set, " { $snippet "pkexec" } " does not set the " { $snippet "$DISPLAY" } " environment variable for child processes, and thus cannot launch graphical applications despite being a graphical program itself. It is tried after " { $snippet "gksudo" } " and " { $snippet "kdesudo" } " but before " { $snippet "sudo" } "." }
|
||||
{ { $snippet "gksudo" } " and " { $snippet "kdesudo" } " are deprecated, but still present on most GTK- and KDE-based systems, respectively. GTK is more widespread than KDE so " { $snippet "gksudo" } " is tried before " { $snippet "kdesudo" } ". These old-fashioned methods ensure that the launched application can be graphical, so they are preferred for Factor." }
|
||||
{ { $snippet "sudo" } " is the final and most robust strategy tried on Linux. It is text-based, so it requires the calling process to have an active and accessible terminal (TTY) for user authentication. If the calling Factor application was started from the desktop graphical shell rather than from a TTY, this method will fail." }
|
||||
}
|
||||
"On other Unix-like or POSIX-like operating systems, " { $snippet "sudo" } " is the only consistently popular method of authentication, and it suffers the same drawback on other Unix-likes as on Linux."
|
||||
{ $heading "Windows" }
|
||||
{ "On Windows, the FFI word " { $resolve? "windows.shell32" "ShellExecuteW" } " is used with the verb " { $snippet "runas" } " to force the new process to run with User Account Control. Windows provides no " { $snippet "exec" } " equivalent to replace a running process' image, so a new process will always be spawned, optionally killing the original Factor process." }
|
||||
;
|
||||
|
||||
HELP: elevated
|
||||
{ $values { "command" { $or array string } } { "replace?" boolean } { "win-console?" boolean } { "posix-graphical" boolean } }
|
||||
{ $description
|
||||
"Spawn a process from the command " { $slot "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 " { $slot "replace?" } " is " { $link t } ", the calling Factor process will be replaced with the command (but see Notes)."
|
||||
$nl
|
||||
{ $link windows } ": if " { $slot "win-console?" } " is " { $link t } ", a new console window will " { $emphasis "always" } " be spawned for the resulting process, regardless of " { $slot "replace?" } "."
|
||||
$nl
|
||||
{ $link unix } ": if " { $slot "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 " { $link windows } ", " { $slot "replace?" } " has the effect of ending (with " { $link exit } ") the calling Factor process after spawning the command because Windows provides no way to replace a running process' image, like " { $snippet "exec" } " does in POSIX." }
|
||||
{ "On POSIX (" { $link unix } "), " { $slot "replace?" } " does not cause a graceful shutdown of the calling Factor VM or thread. Instead, the " { $emphasis "entire" } " executable program image will be immediately replaced in memory by the new command prefixed by a privilege elevation strategy. For more information, see " { $resolve? "unix.process" "exec-with-path" } " and the Unix " { $snippet "man" } " page for " { $resolve? "unix.process" "execvp" } " (" { $resolve? "unix.process" "exec" } ") in section 3." }
|
||||
{ { $link "elevate.bugs" } " details problems and pitfalls of this word." }
|
||||
}
|
||||
}
|
||||
{ $errors
|
||||
{ $link elevated-failed } " when all strategies fail."
|
||||
$nl
|
||||
"When " { $slot "replace?" } " is " { $link t } ":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 the calling Factor process to normal userspace." }
|
||||
{ $notes
|
||||
{ $list
|
||||
{ "On " { $link windows } " this word is a no-op, because there Windows provides no " { $snippet "setuid" } " equivalent to change the access token of a running process. It does not throw an error, so that it may be used in cross-platform code." }
|
||||
{ "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." } ;
|
||||
|
||||
HELP: already-root?
|
||||
{ $description "Determine whether the current Factor process (on " { $link unix } ") or hardware thread {on " { $link windows } ") has administrator or elevated (root) privileges." } ;
|
||||
HELP: lowered-failed
|
||||
{ $error-description "Thrown by " { $link lowered } " when giving up elevated privileges resulted in an error or failure by the operating system." } ;
|
||||
HELP: elevated-failed
|
||||
{ $error-description "Thrown by " { $link elevated } " when all strategies to elevating privileges failed. See " { $link elevated } "." } ;
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
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 ;
|
||||
|
||||
GENERIC#: prepend-command 1 ( command word -- word+command )
|
||||
M: array prepend-command
|
||||
prefix ;
|
||||
|
||||
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 ;
|
||||
|
||||
PRIVATE>
|
||||
HOOK: already-root? os ( -- ? )
|
||||
|
||||
HOOK: elevated os ( command replace? win-console? posix-graphical? -- process )
|
||||
HOOK: lowered os ( -- )
|
||||
|
||||
: elevate ( win-console? posix-graphical? -- ) [ (command-line) t ] 2dip elevated drop ;
|
||||
|
||||
os unix? [ "elevate.unix" require ] when
|
||||
|
||||
{
|
||||
{ [ 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 @@
|
|||
linux
|
|
@ -0,0 +1,28 @@
|
|||
USING: accessors arrays cocoa.apple-script elevate
|
||||
elevate.unix.private formatting io.launcher kernel locals
|
||||
sequences system ;
|
||||
IN: elevate.macosx
|
||||
|
||||
<PRIVATE
|
||||
: apple-script-elevated ( command -- )
|
||||
first 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
|
||||
] [
|
||||
! graphical through applescript
|
||||
posix-graphical? [
|
||||
command apple-script-elevated
|
||||
] when
|
||||
posix-elevated "lol3" throw
|
||||
] if "lol" throw ;
|
||||
|
||||
M: macosx lowered
|
||||
posix-lowered ;
|
||||
|
||||
PRIVATE>
|
||||
|
|
@ -0,0 +1 @@
|
|||
macosx
|
|
@ -0,0 +1 @@
|
|||
Cross-platform API for elevated permissions
|
|
@ -0,0 +1,3 @@
|
|||
os
|
||||
bindings
|
||||
windows
|
|
@ -0,0 +1 @@
|
|||
unix
|
|
@ -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 @@
|
|||
windows
|
|
@ -0,0 +1,30 @@
|
|||
USING: accessors alien alien.c-types elevate io.launcher kernel
|
||||
locals math sequences splitting strings system windows.errors
|
||||
windows.kernel32 windows.shell32 windows.user32 ;
|
||||
IN: elevate.windows
|
||||
|
||||
<PRIVATE
|
||||
! TODO
|
||||
M: windows already-root?
|
||||
! https://msdn.microsoft.com/en-us/library/windows/desktop/aa379296(v=vs.85).aspx
|
||||
! https://msdn.microsoft.com/en-us/library/windows/desktop/aa446671%28v=vs.85%29.aspx
|
||||
! https://msdn.microsoft.com/en-us/library/windows/desktop/ms683182(v=vs.85).aspx
|
||||
f ;
|
||||
|
||||
M:: windows elevated ( command replace? win-console? posix-graphical? -- process )
|
||||
already-root? [
|
||||
<process> command >>command
|
||||
] [
|
||||
! hwnd lpOperation
|
||||
f "runas"
|
||||
command dup string? [ " " split ] when
|
||||
! lpFile lpParameters lpDirectory (enum)nShowCmd
|
||||
[ first ] [ rest ] bi " " join f SW_SHOW
|
||||
! call shell function with questionable return pointer handling (should use WaitForSingleObject but it hangs)
|
||||
ShellExecuteW alien-address :> retval retval 32 <= [ retval n>win32-error-check ] [ ] if
|
||||
replace? [ exit ] [ ] if
|
||||
] if ;
|
||||
|
||||
! no-op (not possible to lower)
|
||||
M: windows lowered ;
|
||||
PRIVATE>
|
Loading…
Reference in New Issue