basis-library/posix/proc-env.sml

   1 (* Copyright (C) 2011,2017 Matthew Fluet.
   2  * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
   3  *    Jagannathan, and Stephen Weeks.
   4  * Copyright (C) 1997-2000 NEC Research Institute.
   5  *
   6  * MLton is released under a BSD-style license.
   7  * See the file MLton-LICENSE for details.
   8  *)
   9
  10 structure PosixProcEnv: POSIX_PROC_ENV =
  11    struct
  12       structure Prim = PrimitiveFFI.Posix.ProcEnv
  13       structure FileDesc = PrePosix.FileDesc
  14       structure GId = PrePosix.GId
  15       structure PId = PrePosix.PId
  16       structure UId = PrePosix.UId
  17
  18       structure Error = PosixError
  19       structure SysCall = Error.SysCall
  20       structure CS = CUtil.C_String
  21       structure CSS = CUtil.C_StringArray
  22
  23       type file_desc = FileDesc.t
  24       type gid = GId.t
  25       type pid = PId.t
  26       type uid = UId.t
  27
  28       val uidToWord = C_UId.castToSysWord o UId.toRep
  29       val wordToUid = UId.fromRep o C_UId.castFromSysWord
  30       val gidToWord = C_GId.castToSysWord o GId.toRep
  31       val wordToGid = GId.fromRep o C_GId.castFromSysWord
  32
  33       local
  34          open Prim
  35       in
  36          val getpgrp = PId.fromRep o getpgrp (* No error checking required *)
  37          val getegid = GId.fromRep o getegid (* No error checking required *)
  38          val geteuid = UId.fromRep o geteuid (* No error checking required *)
  39          val getgid = GId.fromRep o getgid (* No error checking required *)
  40          val getpid = PId.fromRep o getpid (* No error checking required *)
  41          val getppid = PId.fromRep o  getppid (* No error checking required *)
  42          val getuid = UId.fromRep o getuid (* No error checking required *)
  43          val setgid = fn gid => let val gid = GId.toRep gid
  44                                 in SysCall.simple (fn () => setgid gid)
  45                                 end
  46          val setuid = fn uid => let val uid = UId.toRep uid
  47                                 in SysCall.simple (fn () => setuid uid)
  48                                 end
  49       end
  50
  51       fun setsid () =
  52          (PId.fromRep o SysCall.simpleResult')
  53          ({errVal = C_PId.castFromFixedInt ~1}, Prim.setsid)
  54
  55       fun getgroups () =
  56          SysCall.syscall
  57          (fn () =>
  58           let
  59              val n = Prim.getgroupsN ()
  60              val a: C_GId.t array = Array.alloc (C_Int.toInt n)
  61           in
  62              (Prim.getgroups (n, a), fn n =>
  63               (GId.listFromRep o ArraySlice.toList)
  64               (ArraySlice.slice (a, 0, SOME (C_Int.toInt n))))
  65           end)
  66
  67       fun getlogin () =
  68          SysCall.syscall'
  69          ({errVal = CUtil.C_Pointer.null}, fn () =>
  70           (Prim.getlogin (), fn cs =>
  71            CS.toString cs))
  72
  73       fun setpgid {pid, pgid} =
  74          let
  75             val pid = case pid of NONE => 0 | SOME pid => PId.toRep pid
  76             val pgid = case pgid of NONE => 0 | SOME pgid => PId.toRep pgid
  77          in
  78             SysCall.simple
  79             (fn () => Prim.setpgid (pid, pgid))
  80          end
  81
  82       fun uname () =
  83          SysCall.syscall
  84          (fn () =>
  85           (Prim.uname (), fn _ =>
  86            [("sysname", CS.toString (Prim.Uname.getSysName ())),
  87             ("nodename", CS.toString (Prim.Uname.getNodeName ())),
  88             ("release", CS.toString (Prim.Uname.getRelease ())),
  89             ("version", CS.toString (Prim.Uname.getVersion ())),
  90             ("machine", CS.toString (Prim.Uname.getMachine ()))]))
  91
  92       val time = Time.now
  93
  94       local
  95          local
  96             infixr 5 ::?
  97             fun (n,s) ::? l =
  98                if n = C_Int.fromInt ~1
  99                   then l
 100                   else (n,s) :: l
 101          in
 102             val sysconfNames =
 103                (Prim.SC_2_CHAR_TERM,"2_CHAR_TERM") ::?
 104                (Prim.SC_2_C_BIND,"2_C_BIND") ::?
 105                (Prim.SC_2_C_DEV,"2_C_DEV") ::?
 106                (Prim.SC_2_FORT_DEV,"2_FORT_DEV") ::?
 107                (Prim.SC_2_FORT_RUN,"2_FORT_RUN") ::?
 108                (Prim.SC_2_LOCALEDEF,"2_LOCALEDEF") ::?
 109                (Prim.SC_2_PBS,"2_PBS") ::?
 110                (Prim.SC_2_PBS_ACCOUNTING,"2_PBS_ACCOUNTING") ::?
 111                (Prim.SC_2_PBS_CHECKPOINT,"2_PBS_CHECKPOINT") ::?
 112                (Prim.SC_2_PBS_LOCATE,"2_PBS_LOCATE") ::?
 113                (Prim.SC_2_PBS_MESSAGE,"2_PBS_MESSAGE") ::?
 114                (Prim.SC_2_PBS_TRACK,"2_PBS_TRACK") ::?
 115                (Prim.SC_2_SW_DEV,"2_SW_DEV") ::?
 116                (Prim.SC_2_UPE,"2_UPE") ::?
 117                (Prim.SC_2_VERSION,"2_VERSION") ::?
 118                (Prim.SC_ADVISORY_INFO,"ADVISORY_INFO") ::?
 119                (Prim.SC_AIO_LISTIO_MAX,"AIO_LISTIO_MAX") ::?
 120                (Prim.SC_AIO_MAX,"AIO_MAX") ::?
 121                (Prim.SC_AIO_PRIO_DELTA_MAX,"AIO_PRIO_DELTA_MAX") ::?
 122                (Prim.SC_ARG_MAX,"ARG_MAX") ::?
 123                (Prim.SC_ASYNCHRONOUS_IO,"ASYNCHRONOUS_IO") ::?
 124                (Prim.SC_ATEXIT_MAX,"ATEXIT_MAX") ::?
 125                (Prim.SC_AVPHYS_PAGES,"AVPHYS_PAGES") ::?
 126                (Prim.SC_BARRIERS,"BARRIERS") ::?
 127                (Prim.SC_BC_BASE_MAX,"BC_BASE_MAX") ::?
 128                (Prim.SC_BC_DIM_MAX,"BC_DIM_MAX") ::?
 129                (Prim.SC_BC_SCALE_MAX,"BC_SCALE_MAX") ::?
 130                (Prim.SC_BC_STRING_MAX,"BC_STRING_MAX") ::?
 131                (Prim.SC_CHILD_MAX,"CHILD_MAX") ::?
 132                (Prim.SC_CLK_TCK,"CLK_TCK") ::?
 133                (Prim.SC_CLOCK_SELECTION,"CLOCK_SELECTION") ::?
 134                (Prim.SC_COLL_WEIGHTS_MAX,"COLL_WEIGHTS_MAX") ::?
 135                (Prim.SC_CPUTIME,"CPUTIME") ::?
 136                (Prim.SC_DELAYTIMER_MAX,"DELAYTIMER_MAX") ::?
 137                (Prim.SC_EXPR_NEST_MAX,"EXPR_NEST_MAX") ::?
 138                (Prim.SC_FSYNC,"FSYNC") ::?
 139                (Prim.SC_GETGR_R_SIZE_MAX,"GETGR_R_SIZE_MAX") ::?
 140                (Prim.SC_GETPW_R_SIZE_MAX,"GETPW_R_SIZE_MAX") ::?
 141                (Prim.SC_HOST_NAME_MAX,"HOST_NAME_MAX") ::?
 142                (Prim.SC_IOV_MAX,"IOV_MAX") ::?
 143                (Prim.SC_IPV6,"IPV6") ::?
 144                (Prim.SC_JOB_CONTROL,"JOB_CONTROL") ::?
 145                (Prim.SC_LINE_MAX,"LINE_MAX") ::?
 146                (Prim.SC_LOGIN_NAME_MAX,"LOGIN_NAME_MAX") ::?
 147                (Prim.SC_MAPPED_FILES,"MAPPED_FILES") ::?
 148                (Prim.SC_MEMLOCK,"MEMLOCK") ::?
 149                (Prim.SC_MEMLOCK_RANGE,"MEMLOCK_RANGE") ::?
 150                (Prim.SC_MEMORY_PROTECTION,"MEMORY_PROTECTION") ::?
 151                (Prim.SC_MESSAGE_PASSING,"MESSAGE_PASSING") ::?
 152                (Prim.SC_MONOTONIC_CLOCK,"MONOTONIC_CLOCK") ::?
 153                (Prim.SC_MQ_OPEN_MAX,"MQ_OPEN_MAX") ::?
 154                (Prim.SC_MQ_PRIO_MAX,"MQ_PRIO_MAX") ::?
 155                (Prim.SC_NGROUPS_MAX,"NGROUPS_MAX") ::?
 156                (Prim.SC_NPROCESSORS_CONF,"NPROCESSORS_CONF") ::?
 157                (Prim.SC_NPROCESSORS_ONLN,"NPROCESSORS_ONLN") ::?
 158                (Prim.SC_OPEN_MAX,"OPEN_MAX") ::?
 159                (Prim.SC_PAGESIZE,"PAGESIZE") ::?
 160                (Prim.SC_PAGE_SIZE,"PAGE_SIZE") ::?
 161                (Prim.SC_PHYS_PAGES,"PHYS_PAGES") ::?
 162                (Prim.SC_PRIORITIZED_IO,"PRIORITIZED_IO") ::?
 163                (Prim.SC_PRIORITY_SCHEDULING,"PRIORITY_SCHEDULING") ::?
 164                (Prim.SC_RAW_SOCKETS,"RAW_SOCKETS") ::?
 165                (Prim.SC_READER_WRITER_LOCKS,"READER_WRITER_LOCKS") ::?
 166                (Prim.SC_REALTIME_SIGNALS,"REALTIME_SIGNALS") ::?
 167                (Prim.SC_REGEXP,"REGEXP") ::?
 168                (Prim.SC_RE_DUP_MAX,"RE_DUP_MAX") ::?
 169                (Prim.SC_RTSIG_MAX,"RTSIG_MAX") ::?
 170                (Prim.SC_SAVED_IDS,"SAVED_IDS") ::?
 171                (Prim.SC_SEMAPHORES,"SEMAPHORES") ::?
 172                (Prim.SC_SEM_NSEMS_MAX,"SEM_NSEMS_MAX") ::?
 173                (Prim.SC_SEM_VALUE_MAX,"SEM_VALUE_MAX") ::?
 174                (Prim.SC_SHARED_MEMORY_OBJECTS,"SHARED_MEMORY_OBJECTS") ::?
 175                (Prim.SC_SHELL,"SHELL") ::?
 176                (Prim.SC_SIGQUEUE_MAX,"SIGQUEUE_MAX") ::?
 177                (Prim.SC_SPAWN,"SPAWN") ::?
 178                (Prim.SC_SPIN_LOCKS,"SPIN_LOCKS") ::?
 179                (Prim.SC_SPORADIC_SERVER,"SPORADIC_SERVER") ::?
 180                (Prim.SC_SS_REPL_MAX,"SS_REPL_MAX") ::?
 181                (Prim.SC_STREAM_MAX,"STREAM_MAX") ::?
 182                (Prim.SC_SYMLOOP_MAX,"SYMLOOP_MAX") ::?
 183                (Prim.SC_SYNCHRONIZED_IO,"SYNCHRONIZED_IO") ::?
 184                (Prim.SC_THREADS,"THREADS") ::?
 185                (Prim.SC_THREAD_ATTR_STACKADDR,"THREAD_ATTR_STACKADDR") ::?
 186                (Prim.SC_THREAD_ATTR_STACKSIZE,"THREAD_ATTR_STACKSIZE") ::?
 187                (Prim.SC_THREAD_CPUTIME,"THREAD_CPUTIME") ::?
 188                (Prim.SC_THREAD_DESTRUCTOR_ITERATIONS,"THREAD_DESTRUCTOR_ITERATIONS") ::?
 189                (Prim.SC_THREAD_KEYS_MAX,"THREAD_KEYS_MAX") ::?
 190                (Prim.SC_THREAD_PRIORITY_SCHEDULING,"THREAD_PRIORITY_SCHEDULING") ::?
 191                (Prim.SC_THREAD_PRIO_INHERIT,"THREAD_PRIO_INHERIT") ::?
 192                (Prim.SC_THREAD_PRIO_PROTECT,"THREAD_PRIO_PROTECT") ::?
 193                (Prim.SC_THREAD_PROCESS_SHARED,"THREAD_PROCESS_SHARED") ::?
 194                (Prim.SC_THREAD_SAFE_FUNCTIONS,"THREAD_SAFE_FUNCTIONS") ::?
 195                (Prim.SC_THREAD_SPORADIC_SERVER,"THREAD_SPORADIC_SERVER") ::?
 196                (Prim.SC_THREAD_STACK_MIN,"THREAD_STACK_MIN") ::?
 197                (Prim.SC_THREAD_THREADS_MAX,"THREAD_THREADS_MAX") ::?
 198                (Prim.SC_TIMEOUTS,"TIMEOUTS") ::?
 199                (Prim.SC_TIMERS,"TIMERS") ::?
 200                (Prim.SC_TIMER_MAX,"TIMER_MAX") ::?
 201                (Prim.SC_TRACE,"TRACE") ::?
 202                (Prim.SC_TRACE_EVENT_FILTER,"TRACE_EVENT_FILTER") ::?
 203                (Prim.SC_TRACE_EVENT_NAME_MAX,"TRACE_EVENT_NAME_MAX") ::?
 204                (Prim.SC_TRACE_INHERIT,"TRACE_INHERIT") ::?
 205                (Prim.SC_TRACE_LOG,"TRACE_LOG") ::?
 206                (Prim.SC_TRACE_NAME_MAX,"TRACE_NAME_MAX") ::?
 207                (Prim.SC_TRACE_SYS_MAX,"TRACE_SYS_MAX") ::?
 208                (Prim.SC_TRACE_USER_EVENT_MAX,"TRACE_USER_EVENT_MAX") ::?
 209                (Prim.SC_TTY_NAME_MAX,"TTY_NAME_MAX") ::?
 210                (Prim.SC_TYPED_MEMORY_OBJECTS,"TYPED_MEMORY_OBJECTS") ::?
 211                (Prim.SC_TZNAME_MAX,"TZNAME_MAX") ::?
 212                (Prim.SC_V6_ILP32_OFF32,"V6_ILP32_OFF32") ::?
 213                (Prim.SC_V6_ILP32_OFFBIG,"V6_ILP32_OFFBIG") ::?
 214                (Prim.SC_V6_LP64_OFF64,"V6_LP64_OFF64") ::?
 215                (Prim.SC_V6_LPBIG_OFFBIG,"V6_LPBIG_OFFBIG") ::?
 216                (Prim.SC_VERSION,"VERSION") ::?
 217                (Prim.SC_XBS5_ILP32_OFF32,"XBS5_ILP32_OFF32") ::?
 218                (Prim.SC_XBS5_ILP32_OFFBIG,"XBS5_ILP32_OFFBIG") ::?
 219                (Prim.SC_XBS5_LP64_OFF64,"XBS5_LP64_OFF64") ::?
 220                (Prim.SC_XBS5_LPBIG_OFFBIG,"XBS5_LPBIG_OFFBIG") ::?
 221                (Prim.SC_XOPEN_CRYPT,"XOPEN_CRYPT") ::?
 222                (Prim.SC_XOPEN_ENH_I18N,"XOPEN_ENH_I18N") ::?
 223                (Prim.SC_XOPEN_LEGACY,"XOPEN_LEGACY") ::?
 224                (Prim.SC_XOPEN_REALTIME,"XOPEN_REALTIME") ::?
 225                (Prim.SC_XOPEN_REALTIME_THREADS,"XOPEN_REALTIME_THREADS") ::?
 226                (Prim.SC_XOPEN_SHM,"XOPEN_SHM") ::?
 227                (Prim.SC_XOPEN_STREAMS,"XOPEN_STREAMS") ::?
 228                (Prim.SC_XOPEN_UNIX,"XOPEN_UNIX") ::?
 229                (Prim.SC_XOPEN_VERSION,"XOPEN_VERSION") ::?
 230                []
 231          end
 232       in
 233          fun sysconf s =
 234             case List.find (fn (_, s') => s = s') sysconfNames of
 235                NONE => Error.raiseSys Error.inval
 236              | SOME (n, _) =>
 237                   (SysWord.fromLargeInt o C_Long.toLarge o SysCall.simpleResult')
 238                   ({errVal = C_Long.fromInt ~1}, fn () => Prim.sysconf n)
 239       end
 240
 241       local
 242          structure Times = Prim.Times
 243
 244          val clocksPerSec =
 245             (* syconf is not implemented on MinGW;
 246              * we don't want a SysErr during Basis Library initialization.
 247              *)
 248             if (let open Primitive.MLton.Platform.OS in host = MinGW end)
 249                then LargeInt.zero
 250             else SysWord.toLargeIntX (sysconf "CLK_TCK")
 251
 252          fun cvt (clocks: C_Clock.t) =
 253             Time.fromTicks (LargeInt.quot
 254                             (LargeInt.* (C_Clock.toLargeInt clocks,
 255                                          Time.ticksPerSecond),
 256                              clocksPerSec))
 257       in
 258          fun times () =
 259             SysCall.syscall'
 260             ({errVal = C_Clock.castFromFixedInt ~1}, fn () =>
 261              (Prim.times (), fn elapsed =>
 262               {elapsed = cvt elapsed,
 263                utime = cvt (Times.getUTime ()),
 264                stime = cvt (Times.getSTime ()),
 265                cutime = cvt (Times.getCUTime ()),
 266                cstime = cvt (Times.getCSTime ())}))
 267       end
 268
 269       fun environ () = CSS.toList (Prim.environGet ())
 270
 271       fun getenv name =
 272          let
 273             val cs = Prim.getenv (NullString.nullTerm name)
 274          in
 275             if CUtil.C_Pointer.isNull cs
 276                then NONE
 277             else SOME (CS.toString cs)
 278          end
 279
 280       fun ctermid () = CS.toString (Prim.ctermid ())
 281
 282       fun isatty fd = (Prim.isatty (FileDesc.toRep fd)) <> C_Int.zero
 283
 284       fun ttyname fd =
 285          SysCall.syscall'
 286          ({errVal = CUtil.C_Pointer.null}, fn () =>
 287           (Prim.ttyname (FileDesc.toRep fd), fn cs =>
 288            CS.toString cs))
 289    end