os-specific refactor appears to work on Linux

basis/elevate/elevate.factor

@@ -1,99 +1,34 @@
-USING: accessors arrays assocs command-line environment
+USING: accessors arrays assocs combinators command-line
-formatting fry io.launcher kernel ui locals math namespaces
+environment formatting fry io.launcher kernel locals math
-sequences splitting strings system unix.ffi unix.process ;
+namespaces sequences splitting strings system ui vocabs ;
 IN: elevate
 
 <PRIVATE
 ERROR: elevated-failed command { strategies array } ;
 ERROR: lowered-failed ;
 
-CONSTANT: apple-script-charmap H{
+GENERIC#: prepend-command 1 ( command word -- word+command )
-    { "\n" "\\n" }
+M: array prepend-command
-    { "\r" "\\r" }
+    prefix ;
-    { "\t" "\\t" }
-    { "\"" "\\\"" }
-    { "\\" "\\\\" }
-}
 
-: quote-apple-script ( str -- str' )
+M: string prepend-command
-    [ 1string [ apple-script-charmap at ] [ ] bi or ] { } map-as
+    swap " " glue ;
-    "" 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 ;
 
 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 )
-
+HOOK: lowered  os ( -- )
-! 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 ;
 
 : elevate ( win-console? posix-graphical? -- ) [ (command-line) t ] 2dip elevated drop ;
 
-HOOK: lowered os ( -- )
+{
-
+    { [ os windows? ] [ "elevate.windows" require ] }
-! https://wiki.sei.cmu.edu/confluence/display/c/POS36-C.+Observe+correct+revocation+order+while+relinquishing+privileges
+    { [ os linux? ] [ "elevate.linux" require ] }
-! group ID must be lowered before user ID otherwise program may re-gain root!
+    { [ os macosx? ] [ "elevate.macosx" require ] }
-M: linux lowered
+} cond
-    posix-lowered ;
-
-M: macosx lowered
-    posix-lowered ;
-
-M: windows lowered ;

basis/elevate/linux/linux.factor

@@ -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>

basis/elevate/macosx/macosx.factor

@@ -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>
+

basis/elevate/unix/unix.factor

@@ -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>

basis/elevate/windows/windows.factor

@@ -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>