basis/elevate/elevate.factor

   1 USING: accessors arrays assocs command-line environment
   2 formatting fry io.launcher kernel ui locals math namespaces
   3 sequences splitting strings system unix.ffi unix.process ;
   4 IN: elevate
   5
   6 <PRIVATE
   7 ERROR: elevated-failed path ;
   8 ERROR: lowered-failed ;
   9
  10 CONSTANT: apple-script-charmap H{
  11     { "\n" "\\n" }
  12     { "\r" "\\r" }
  13     { "\t" "\\t" }
  14     { "\"" "\\\"" }
  15     { "\\" "\\\\" }
  16 }
  17
  18 : quote-apple-script ( str -- str' )
  19     [ 1string [ apple-script-charmap at ] [ ] bi or ] { } map-as
  20     "" join "\"" dup surround ;
  21
  22 : run-apple-script ( str -- ) drop ;
  23
  24 : apple-script-elevated ( command -- )
  25     quote-apple-script
  26     "do shell script %s with administrator privileges without altering line endings"
  27     sprintf run-apple-script ;
  28
  29 : posix-replace-process ( command-list -- code )
  30   [ first ] [ rest ] bi exec-with-path ;
  31
  32 GENERIC: glue-command ( prefix command -- glued )
  33
  34 M: array glue-command
  35     swap prefix ;
  36
  37 M: string glue-command
  38     " " glue ;
  39
  40 GENERIC: failed-process? ( process -- ? )
  41 M: f failed-process? not ;
  42 M: fixnum failed-process? -1 = ;
  43 M: process failed-process? status>> zero? not ;
  44
  45 PRIVATE>
  46
  47 HOOK: elevated os ( command replace? win-console? posix-graphical? -- process )
  48
  49 ! TODO
  50 M: windows elevated
  51     3drop run-process ;
  52
  53 ! TODO
  54 M:: macosx elevated ( command replace? win-console? posix-graphical? -- process )
  55     posix-graphical? [ ! graphical (through applescript)
  56         command apple-script-elevated
  57     ] when
  58     command replace? win-console? posix-graphical?
  59     linux os [ elevated ] with-variable ;
  60
  61 M:: linux elevated ( command replace? win-console? posix-graphical? -- process )
  62     getuid zero? [
  63         <process> command >>command ! we are already root: just give a process
  64     ] [
  65         ! graphical handled
  66         posix-graphical? ui-running? or "DISPLAY" os-env and
  67         { "gksudo" "kdesudo" "sudo" } { "sudo" } ?
  68
  69         command '[ _ glue-command ] map [
  70             replace? [
  71                 " " split posix-replace-process
  72             ] [ run-process ] if
  73         ] map
  74         ! if they all failed, then it failed, but if one passed, that's normal (success)
  75         [ [ failed-process? ] all? [ command elevated-failed ] [ ] if ] keep
  76     ] if ;
  77
  78 : elevate ( win-console? posix-graphical? -- ) [ (command-line) t ] 2dip elevated drop ;
  79
  80 HOOK: lowered os ( -- )
  81
  82 ! https://wiki.sei.cmu.edu/confluence/display/c/POS36-C.+Observe+correct+revocation+order+while+relinquishing+privileges
  83 ! group ID must be lowered before user ID otherwise program may re-gain root!
  84 M: linux lowered
  85     getgid setgid failed-process? [ lowered-failed ] [ ] if
  86     getuid setuid failed-process? [ lowered-failed ] [ ] if ;
  87
  88 M: macosx lowered
  89     linux os [ lowered ] with-variable ;
  90
  91 M: windows lowered ;