src/main-client.sml

   1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
   2  * Copyright (c) 2006, Adam Chlipala
   3  *
   4  * This program is free software; you can redistribute it and/or
   5  * modify it under the terms of the GNU General Public License
   6  * as published by the Free Software Foundation; either version 2
   7  * of the License, or (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this program; if not, write to the Free Software
  16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  17  *)
  18
  19 (* Driver for configuration requests *)
  20
  21 val () = Domain.declareClient ()
  22
  23 fun uid () =
  24     case Posix.ProcEnv.getenv "DOMTOOL_USER" of
  25         NONE => Posix.ProcEnv.getuid ()
  26       | SOME user => Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam user)
  27
  28 fun domtoolRoot () =
  29     let
  30         val dname = Posix.SysDB.Passwd.home (Posix.SysDB.getpwuid (uid ()))
  31     in
  32         OS.Path.joinDirFile {dir = dname,
  33                              file = ".domtool"}
  34     end
  35
  36 fun libnameOpt () =
  37     let
  38         val libname = OS.Path.joinDirFile {dir = domtoolRoot (),
  39                                            file = "lib.dtl"}
  40     in
  41         if Posix.FileSys.access (libname, []) then
  42             SOME libname
  43         else
  44             NONE
  45     end
  46
  47 val (tc, fake, args) = foldl (fn (arg, (tc, fake, args)) =>
  48                                  case arg of
  49                                      "-tc" => (true, fake, args)
  50                                    | "-fake" => (tc, true, args)
  51                                    | _ => (tc, fake, arg :: args))
  52                        (false, false, []) (CommandLine.arguments ())
  53
  54 val args = rev args
  55
  56 val (doit, doitDir) =
  57     if tc then
  58         (fn fname =>
  59             let
  60                 val _ : string = Main.setupUser ()
  61                 val () = if fake then
  62                              Domain.fakePrivileges ()
  63                          else
  64                              ()
  65                 val env = Main.basis ()
  66                 val env =
  67                     case libnameOpt () of
  68                         NONE => env
  69                       | SOME libname => #1 (Main.check env libname)
  70             in
  71                 ignore (Main.check env fname)
  72             end,
  73          Main.checkDir)
  74     else
  75         (fn fname => Main.request (fname, libnameOpt ()),
  76          Main.requestDir)
  77
  78 val _ =
  79     case args of
  80         [fname] =>
  81         if Posix.FileSys.access (fname, []) then
  82             doit fname
  83         else
  84             doit (OS.Path.joinDirFile {dir = domtoolRoot (),
  85                                        file = fname})
  86       | [] => doitDir (domtoolRoot ())
  87       | _ => print "Invalid command-line arguments\n"