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 command { strategies array } ;
   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 : already-root? ( -- ? )
  33     getuid geteuid [ zero? ] bi@ or ;
  34
  35 GENERIC: glue-command ( prefix command -- glued )
  36
  37 M: array glue-command
  38     swap prefix ;
  39
  40 M: string glue-command
  41     " " glue ;
  42
  43 GENERIC: failed-process? ( process -- ? )
  44 M: f failed-process? not ;
  45 M: fixnum failed-process? -1 = ;
  46 M: process failed-process? status>> zero? not ;
  47
  48 : posix-lowered ( -- )
  49     getgid setgid failed-process? [ lowered-failed ] [ ] if
  50     getuid setuid failed-process? [ lowered-failed ] [ ] if ;
  51
  52 PRIVATE>
  53
  54 HOOK: elevated os ( command replace? win-console? posix-graphical? -- process )
  55
  56 ! TODO
  57 M: windows elevated
  58     3drop run-process ;
  59
  60 ! TODO
  61 M:: macosx elevated ( command replace? win-console? posix-graphical? -- process )
  62     already-root? [ <process> command >>command 1array ] [
  63         posix-graphical? [ ! graphical (through applescript)
  64             command apple-script-elevated
  65         ] when
  66         command replace? win-console? posix-graphical?
  67         linux os [ elevated ] with-variable
  68     ] if ;
  69
  70 M:: linux elevated ( command replace? win-console? posix-graphical? -- process )
  71     already-root? [
  72         <process> command >>command 1array ! we are already root: just give a process
  73     ] [
  74         ! graphical handled
  75         posix-graphical? ui-running? or "DISPLAY" os-env and
  76         { "gksudo" "kdesudo" "sudo" } { "sudo" } ?
  77
  78         command '[ _ glue-command ] map :> command-list command-list [
  79             replace? [
  80                 " " split posix-replace-process
  81             ] [ run-process ] if
  82         ] map
  83         ! if they all failed, then it failed, but if one passed, that's normal (success)
  84         [ [ failed-process? ] all? [ command command-list elevated-failed ] [ ] if ] keep
  85     ] if ;
  86
  87 : elevate ( win-console? posix-graphical? -- ) [ (command-line) t ] 2dip elevated drop ;
  88
  89 HOOK: lowered os ( -- )
  90
  91 ! https://wiki.sei.cmu.edu/confluence/display/c/POS36-C.+Observe+correct+revocation+order+while+relinquishing+privileges
  92 ! group ID must be lowered before user ID otherwise program may re-gain root!
  93 M: linux lowered
  94     posix-lowered ;
  95
  96 M: macosx lowered
  97     posix-lowered ;
  98
  99 M: windows lowered ;