/* File: "os_shell.c", Time-stamp: <2007-12-19 13:51:53 feeley> */

/* Copyright (c) 1994-2007 by Marc Feeley, All Rights Reserved. */

/*
 * This module implements the operating system specific routines
 * related to the shell.
 */

#define ___INCLUDED_FROM_OS_SHELL
#define ___VERSION 402008
#include "gambit.h"

#include "os_base.h"
#include "os_shell.h"
#include "os_files.h"


/*---------------------------------------------------------------------------*/


___shell_module ___shell_mod =
{
  0

#ifdef ___SHELL_MODULE_INIT
  ___SHELL_MODULE_INIT
#endif
};


/*---------------------------------------------------------------------------*/

/* Access to shell environment variables. */


/****************** obsolete.... use ___getenv_UCS_2 */
char *___getenv
   ___P((char *name),
        (name)
char *name;)
{
  return getenv (name);
}


#define GETENV_NAME_STATIC_SIZE   128
#define GETENV_VALUE_STATIC_SIZE  128
#define SETENV_NAME_STATIC_SIZE   128
#define SETENV_VALUE_STATIC_SIZE  128
#define UNSETENV_NAME_STATIC_SIZE 128


___SCMOBJ ___getenv_UCS_2
   ___P((___UCS_2STRING name,
         ___UCS_2STRING *value),
        (name,
         value)
___UCS_2STRING name;
___UCS_2STRING *value;)
{
  ___SCMOBJ e;
  ___UCS_2STRING v;
  ___UCS_2STRING p1;
  int name_len;

  /* reject strings that contain "=" except as the first character */

  p1 = name;

  if (*p1 == '=')
    p1++;

  while (*p1 != '\0')
    {
#if ENV_CHAR_BYTES == 1
      if (*p1 > 255)
        return ___FIX(___IMPL_LIMIT_ERR);
#endif
      if (*p1++ == '=')
        return ___FIX(___IMPL_LIMIT_ERR);
    }

  name_len = p1 - name;

  /* find in the environment a string of the form name=value */

  e = ___FIX(___NO_ERR);
  *value = 0;

#ifdef USE_environ

  {
    char **probe;
    char *p2;

    probe = environ;

    while ((p2 = *probe++) != 0)
      {
        p1 = name;

        while (*p1 != '\0' &&
               *p1 == ___CAST(___UCS_2,___CAST(unsigned char,*p2)))
          {
            p1++;
            p2++;
          }

        if (*p1 == '\0' && *p2 == '=')
          {
            int len = 0;

            p2++;

            while (p2[len] != '\0')
              len++;

            v = ___CAST(___UCS_2STRING,
                        ___alloc_mem (sizeof (___UCS_2) * (len+1)));

            if (v == 0)
              return ___FIX(___HEAP_OVERFLOW_ERR);

            do
              {
                v[len] = ___CAST(___UCS_2,___CAST(unsigned char,p2[len]));
              } while (len-- > 0);

            *value = v;
          }
      }
  }

#else

  {
#if ENV_CHAR_BYTES == 1

    char *cvalue_ptr = 0;
    char cname[GETENV_NAME_STATIC_SIZE];
    char *cname_ptr = cname;

    if (name_len >= GETENV_NAME_STATIC_SIZE)
      {
        cname_ptr = ___CAST(char*,
                            ___alloc_mem (sizeof (*cname_ptr)
                                          * (name_len+1)));

        if (cname_ptr == 0)
          return ___FIX(___HEAP_OVERFLOW_ERR);
      }

    do
      {
        cname_ptr[name_len] = name[name_len];
      } while (name_len-- > 0);

#else

    ___UCS_2 *cvalue_ptr = 0;
    ___UCS_2 *cname_ptr = name;

#endif

#ifndef USE_getenv
#ifndef USE_GetEnvironmentVariable

    if (cvalue_ptr != 0)

#endif
#endif

#ifdef USE_getenv

    cvalue_ptr = getenv (cname_ptr);

    if (cvalue_ptr != 0)

#endif

#ifdef USE_GetEnvironmentVariable

    {
      ___CHAR_TYPE(___GETENV_CE_SELECT) cvalue[GETENV_VALUE_STATIC_SIZE];
      int n;

      cvalue_ptr = cvalue;

      n = GetEnvironmentVariable
            (cname_ptr,
             cvalue_ptr,
             GETENV_VALUE_STATIC_SIZE);

      if (n >= GETENV_VALUE_STATIC_SIZE)
        {
          cvalue_ptr = ___CAST(___CHAR_TYPE(___GETENV_CE_SELECT)*,
                               ___alloc_mem (sizeof (*cvalue_ptr) * n));

          if (cvalue_ptr != 0)
            n = GetEnvironmentVariable
                  (cname_ptr,
                   cvalue_ptr,
                   n);
        }

      if (cvalue_ptr == 0)
        e = ___FIX(___HEAP_OVERFLOW_ERR);
      else if (n > 0)

#endif

        {
          ___UCS_2STRING v;
          int len = 0;

          while (cvalue_ptr[len] != '\0')
            len++;

          v = ___CAST(___UCS_2STRING,
                      ___alloc_mem (sizeof (___UCS_2) * (len+1)));

          if (v == 0)
            e = ___FIX(___HEAP_OVERFLOW_ERR);
          else
            {
              do
                {
                  v[len] = ___CAST(___UCS_2,cvalue_ptr[len]);
                } while (len-- > 0);

              *value = v;
            }
        }

#ifdef USE_GetEnvironmentVariable

      if (cvalue_ptr != cvalue)
        ___free_mem (cvalue_ptr);
    }

#endif

#if ENV_CHAR_BYTES == 1

    if (cname_ptr != cname)
      ___free_mem (cname_ptr);

#endif
  }

#endif

  return e;
}


___SCMOBJ ___setenv_UCS_2
   ___P((___UCS_2STRING name,
         ___UCS_2STRING value),
        (name,
         value)
___UCS_2STRING name;
___UCS_2STRING value;)
{
  ___SCMOBJ e;
  ___UCS_2STRING p1;
  int name_len;
  int value_len;

  /* reject strings that contain "=" except as the first character */

  p1 = name;

  if (*p1 == '=')
    p1++;

  while (*p1 != '\0')
    {
#if ENV_CHAR_BYTES == 1
      if (*p1 > 255)
        return ___FIX(___IMPL_LIMIT_ERR);
#endif
      if (*p1++ == '=')
        return ___FIX(___IMPL_LIMIT_ERR);
    }

  name_len = p1 - name;

  p1 = value;

  while (*p1 != '\0')
    {
#if ENV_CHAR_BYTES == 1
      if (*p1 > 255)
        return ___FIX(___IMPL_LIMIT_ERR);
#endif
      p1++;
    }

  value_len = p1 - value;

  /* find in the environment a string of the form name=value */

  e = ___FIX(___NO_ERR);

#ifdef USE_environ

  {
    char **old_environ = environ;
    char **probe;
    char *p2;

    char *name_value = ___CAST(char*,
                               ___alloc_mem (name_len + value_len + 2));

    if (name_value == 0)
      return ___FIX(___HEAP_OVERFLOW_ERR);

    p2 = name_value;

    p1 = name;

    while (name_len > 0)
      {
        *p2++ = ___CAST(char,*p1++);
        name_len--;
      }

    *p2++ = '=';

    p1 = value;

    while (value_len > 0)
      {
        *p2++ = ___CAST(char,*p1++);
        value_len--;
      }

    *p2++ = '\0';

    probe = old_environ;

    while ((p2 = *probe++) != 0)
      {
        p1 = name;

        while (*p1 != '\0' &&
               *p1 == ___CAST(___UCS_2,___CAST(unsigned char,*p2)))
          {
            p1++;
            p2++;
          }

        if (*p1 == '\0' && *p2 == '=')
          {
            probe[-1] = name_value;
            return ___FIX(___NO_ERR);
          }
      }

    if (___shell_mod.environ_unused_at_end > 0)
      {
        probe[-1] = name_value;
        probe[0] = 0;
        ___shell_mod.environ_unused_at_end--;
        return ___FIX(___NO_ERR);
      }
    else
      {
        char **new_environ;
        int n = probe - old_environ; /* length including null pointer at end */

        ___shell_mod.environ_unused_at_end = n/2 + 1;

        new_environ =
          ___CAST(char**,
                  ___alloc_mem ((n + ___shell_mod.environ_unused_at_end)
                                * sizeof (char*)));

        if (new_environ == 0)
          {
            ___free_mem (name_value);
            return ___FIX(___HEAP_OVERFLOW_ERR);
          }

        environ = new_environ;
        probe = old_environ;

        while (--n > 0)
          *new_environ++ = *probe++;

        *new_environ++ = name_value;
        *new_environ++ = 0;

        ___shell_mod.environ_unused_at_end--;

        if (___shell_mod.environ_was_extended)
          ___free_mem (old_environ);

        ___shell_mod.environ_was_extended = 1;
      }
  }

#else

  {
#if ENV_CHAR_BYTES == 1

    char *cname_ptr;
    char *cvalue_ptr;
    char cname[SETENV_NAME_STATIC_SIZE];
    char cvalue[SETENV_VALUE_STATIC_SIZE];

    if (name_len < SETENV_NAME_STATIC_SIZE)
      cname_ptr = cname;
    else
      {
        cname_ptr = ___CAST(char*,
                            ___alloc_mem (sizeof (*cname_ptr)
                                          * (name_len+1)));

        if (cname_ptr == 0)
          return ___FIX(___HEAP_OVERFLOW_ERR);
      }

    do
      {
        cname_ptr[name_len] = name[name_len];
      } while (name_len-- > 0);

    if (value_len < SETENV_VALUE_STATIC_SIZE)
      cvalue_ptr = cvalue;
    else
      {
        cvalue_ptr = ___CAST(char*,
                             ___alloc_mem (sizeof (*cvalue_ptr)
                                           * (value_len+1)));

        if (cvalue_ptr == 0)
          {
            if (cname_ptr != cname)
              ___free_mem (cname_ptr);

            return ___FIX(___HEAP_OVERFLOW_ERR);
          }
      }

    do
      {
        cvalue_ptr[value_len] = value[value_len];
      } while (value_len-- > 0);

#else

    ___UCS_2 *cname_ptr = name;
    ___UCS_2 *cvalue_ptr = value;

#endif

#ifdef USE_setenv

    if (setenv (cname_ptr, cvalue_ptr, 1) < 0)
      e = err_code_from_errno ();

#endif

#ifdef USE_SetEnvironmentVariable

    if (!SetEnvironmentVariable (cname_ptr, cvalue_ptr))
      e = err_code_from_GetLastError ();

#endif

#if ENV_CHAR_BYTES == 1

    if (cvalue_ptr != cvalue)
      ___free_mem (cvalue_ptr);

    if (cname_ptr != cname)
      ___free_mem (cname_ptr);

#endif
  }

#endif

  return e;
}


___SCMOBJ ___unsetenv_UCS_2
   ___P((___UCS_2STRING name),
        (name)
___UCS_2STRING name;)
{
  ___SCMOBJ e;
  ___UCS_2STRING p1;
  int name_len;

  /* reject strings that contain "=" except as the first character */

  p1 = name;

  if (*p1 == '=')
    p1++;

  while (*p1 != '\0')
    {
#if ENV_CHAR_BYTES == 1
      if (*p1 > 255)
        return ___FIX(___IMPL_LIMIT_ERR);
#endif
      if (*p1++ == '=')
        return ___FIX(___IMPL_LIMIT_ERR);
    }

  name_len = p1 - name;

  /* find in the environment a string of the form name=value */

  e = ___FIX(___NO_ERR);

#ifdef USE_environ

  {
    char **probe;
    char *p2;

    probe = environ;

    while ((p2 = *probe++) != 0)
      {
        p1 = name;

        while (*p1 != '\0' &&
               *p1 == ___CAST(___UCS_2,___CAST(unsigned char,*p2)))
          {
            p1++;
            p2++;
          }

        if (*p1 == '\0' && *p2 == '=')
          {
            ___shell_mod.environ_unused_at_end++;

            while ((probe[-1] = probe[0]) != 0)
              probe++;

            return ___FIX(___NO_ERR);
          }
      }
  }

#else

  {
#if ENV_CHAR_BYTES == 1

    char *cname_ptr;
    char cname[UNSETENV_NAME_STATIC_SIZE];

    if (name_len < UNSETENV_NAME_STATIC_SIZE)
      cname_ptr = cname;
    else
      {
        cname_ptr = ___CAST(char*,
                            ___alloc_mem (sizeof (*cname_ptr)
                                          * (name_len+1)));

        if (cname_ptr == 0)
          return ___FIX(___HEAP_OVERFLOW_ERR);
      }

    do
      {
        cname_ptr[name_len] = name[name_len];
      } while (name_len-- > 0);

#else

    ___UCS_2 *cname_ptr = name;

#endif

#ifdef USE_unsetenv

    if (unsetenv (cname_ptr) < 0)
      e = err_code_from_errno ();

#endif

#ifdef USE_SetEnvironmentVariable

    if (!SetEnvironmentVariable (cname_ptr, 0))
      {
        e = err_code_from_GetLastError ();

        /*
         * Apparently an error is signaled if the environment
         * variable being removed does not exist (the Microsoft
         * documentation does not mention this).
         */

        if (e == ___FIX(___WIN32_ERR(ERROR_ENVVAR_NOT_FOUND)))
          e = ___FIX(___NO_ERR);
      }

#endif

#if ENV_CHAR_BYTES == 1

    if (cname_ptr != cname)
      ___free_mem (cname_ptr);

#endif
  }

#endif

  return e;
}


___SCMOBJ ___os_getenv
   ___P((___SCMOBJ name),
        (name)
___SCMOBJ name;)
{
  ___SCMOBJ e;
  ___SCMOBJ result;
  ___UCS_2STRING cname;
  ___UCS_2STRING cvalue;

  if ((e = ___SCMOBJ_to_NONNULLUCS_2STRING
             (name,
              &cname,
              1))
      != ___FIX(___NO_ERR))
    result = e;
  else
    {
      if ((e = ___getenv_UCS_2 (cname, &cvalue)) != ___FIX(___NO_ERR))
        result = e;
      else
        {
          if ((e = ___UCS_2STRING_to_SCMOBJ
                     (cvalue,
                      &result,
                      ___RETURN_POS))
              != ___FIX(___NO_ERR))
            result = e;
          else
            ___release_scmobj (result);

          if (cvalue != 0)
            ___free_mem (cvalue);
        }

      ___release_string (cname);
    }

  return result;
}


___SCMOBJ ___os_setenv
   ___P((___SCMOBJ name,
         ___SCMOBJ value),
        (name,
         value)
___SCMOBJ name;
___SCMOBJ value;)
{
  ___SCMOBJ e;
  ___UCS_2STRING cname;
  ___UCS_2STRING cvalue;

  if ((e = ___SCMOBJ_to_NONNULLUCS_2STRING
             (name,
              &cname,
              1))
      == ___FIX(___NO_ERR))
    {
      if (value == ___ABSENT)
        e = ___unsetenv_UCS_2 (cname);
      else if ((e = ___SCMOBJ_to_NONNULLUCS_2STRING
                      (value,
                       &cvalue,
                       2))
               == ___FIX(___NO_ERR))
        {
          e = ___setenv_UCS_2 (cname, cvalue);
          ___release_string (cvalue);
        }

      ___release_string (cname);
    }

  return e;
}


___SCMOBJ ___os_environ ___PVOID
{
  ___SCMOBJ e;
  ___SCMOBJ result;

#ifndef USE_environ
#ifndef USE_GetEnvironmentStrings

  result = ___NUL;

#endif
#endif

#ifdef USE_environ

  if ((e = ___NONNULLCHARSTRINGLIST_to_SCMOBJ
             (environ,
              &result,
              ___RETURN_POS))
      != ___FIX(___NO_ERR))
    result = e;
  else
    ___release_scmobj (result);

#endif

#ifdef USE_GetEnvironmentStrings

  ___STRING_TYPE(___ENVIRON_CE_SELECT) env;
  ___STRING_TYPE(___ENVIRON_CE_SELECT) ptr;
  ___SCMOBJ pair;
  ___SCMOBJ str;

  e = ___FIX(___NO_ERR);
  result = ___NUL;

  env = GetEnvironmentStrings ();

  if (env != 0 && *env != 0)
    {
      ptr = env;

      /* find end of environment strings. */

      do
        {
          do { ptr++; } while (*ptr != 0);
          ptr++; /* skip null char at end of string */
        } while (*ptr != 0);

      while (ptr > env)
        {
          ptr--; /* move ptr to terminating null char of previous string */

          while (ptr > env && ptr[-1] != 0)
            ptr--;

          if ((e = ___NONNULLSTRING_to_SCMOBJ
                     (ptr,
                      &str,
                      ___RETURN_POS,
                      ___CE(___ENVIRON_CE_SELECT)))
              != ___FIX(___NO_ERR))
            break;

          pair = ___make_pair (str, result, ___STILL);

          ___release_scmobj (str);
          ___release_scmobj (result);

          if (___FIXNUMP(pair))
            {
              e = ___FIX(___CTOS_HEAP_OVERFLOW_ERR+___RETURN_POS);
              break;
            }

          result = pair;
        }

      ___release_scmobj (result);
    }

  if (env != 0)
    if (!FreeEnvironmentStrings (env))
      e = err_code_from_GetLastError ();

  if (e != ___FIX(___NO_ERR))
    result = e;

#endif

  return result;
}


/*---------------------------------------------------------------------------*/

/* Shell command. */


___SCMOBJ ___os_shell_command
   ___P((___SCMOBJ cmd,
         ___SCMOBJ dir),
        (cmd,
         dir)
___SCMOBJ cmd;
___SCMOBJ dir;)
{
  ___SCMOBJ e;

#ifndef USE_POSIX
#ifndef USE_WIN32

  e = ___FIX(___UNIMPL_ERR);

#endif
#endif

#ifdef USE_POSIX

  char *ccmd;

  if ((e = ___SCMOBJ_to_NONNULLCHARSTRING
             (cmd,
              &ccmd,
              1))
      == ___FIX(___NO_ERR))
    {
      void *cdir;

      if ((e = ___SCMOBJ_to_NONNULLSTRING
                 (dir,
                  &cdir,
                  2,
                  ___CE(___PATH_CE_SELECT),
                  0))
          == ___FIX(___NO_ERR))
        {
          int code;

          ___CHAR_TYPE(___PATH_CE_SELECT) old_dir[___PATH_MAX_LENGTH+1];

          if (getcwd (old_dir, ___PATH_MAX_LENGTH) == 0)
            e = err_code_from_errno ();
          else
            {
              if (chdir (___CAST(___STRING_TYPE(___PATH_CE_SELECT),cdir)) < 0)
                e = err_code_from_errno ();
              else
                {
                  ___disable_os_interrupts ();

                  code = system (ccmd);

                  if (code == -1)
                    e = err_code_from_errno ();
                  else
                    e = ___FIX(code & ___MAX_FIX);

                  ___enable_os_interrupts ();

                  chdir (old_dir); /* ignore error */
                }
            }

          ___release_string (cdir);
        }

      ___release_string (ccmd);
    }

#endif

#ifdef USE_WIN32

#ifdef _UNICODE
#define ___SHELL_COMMAND_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) ucs2
#else
#define ___SHELL_COMMAND_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
#endif

  void *ccmd;

  if ((e = ___SCMOBJ_to_NONNULLSTRING
             (cmd,
              &ccmd,
              1,
              ___CE(___SHELL_COMMAND_CE_SELECT),
              0))
      == ___FIX(___NO_ERR))
    {
      void *cdir;

      if ((e = ___SCMOBJ_to_STRING
                 (dir,
                  &cdir,
                  2,
                  ___CE(___PATH_CE_SELECT),
                  0))
          == ___FIX(___NO_ERR))
        {
          DWORD n;

          ___CHAR_TYPE(___PATH_CE_SELECT) old_dir[___PATH_MAX_LENGTH+1];

          n = GetCurrentDirectory (___PATH_MAX_LENGTH+1,
                                   old_dir);

          if (n < 1 || n > ___PATH_MAX_LENGTH)
            e = err_code_from_GetLastError ();
          else
            {
              if (!SetCurrentDirectory (___CAST(___STRING_TYPE(___PATH_CE_SELECT),cdir)))
                e = err_code_from_GetLastError ();
              else
                {

#ifdef ___DO_NOT_USE_system

                  /*
                   * This code does not really cause the shell to run
                   * the command.  This means that the shell builtin
                   * commands (such as "DIR" cannot be executed.  It
                   * is better to use "system" and "_wsystem".
                   */

                  DWORD code;
                  STARTUPINFO si;
                  PROCESS_INFORMATION pi;

                  ZeroMemory (&si, sizeof (si));
                  si.cb = sizeof (si);
                  ZeroMemory (&pi, sizeof (pi));

                  if (!CreateProcess
                         (NULL,  /* module name                              */
                          ___CAST(___STRING_TYPE(___SHELL_COMMAND_CE_SELECT),ccmd),
                          NULL,  /* process handle not inheritable           */
                          NULL,  /* thread handle not inheritable            */
                          FALSE, /* set handle inheritance to FALSE          */
                          0,     /* no creation flags                        */
                          NULL,  /* use parent's environment block           */
                          NULL,  /* use parent's starting directory          */
                          &si,   /* pointer to STARTUPINFO structure         */
                          &pi))  /* pointer to PROCESS_INFORMATION structure */
                    e = err_code_from_GetLastError ();
                  else
                    {
                      if (WaitForSingleObject (pi.hProcess, INFINITE) == WAIT_FAILED ||
                          !GetExitCodeProcess (pi.hProcess, &code))
                        e = err_code_from_GetLastError ();
                      else
                        e = ___FIX(code & ___MAX_FIX);

                      CloseHandle (pi.hProcess); /* ignore error */
                      CloseHandle (pi.hThread); /* ignore error */
                    }

#else

                  int code;

#ifdef _UNICODE
                  code = _wsystem (___CAST(___STRING_TYPE(___SHELL_COMMAND_CE_SELECT),ccmd));
#else
                  code = system (___CAST(___STRING_TYPE(___SHELL_COMMAND_CE_SELECT),ccmd));
#endif

                  if (code == -1)
                    e = err_code_from_errno ();
                  else
                    e = ___FIX(code & ___MAX_FIX);

#endif

                  SetCurrentDirectory (old_dir); /* ignore error */
                }
            }

          ___release_string (cdir);
        }

      ___release_string (ccmd);
    }

#endif

  return e;
}


/*---------------------------------------------------------------------------*/

/* Shell module initialization/finalization. */


___SCMOBJ ___setup_shell_module ___PVOID
{
  if (!___shell_mod.setup)
    {
#ifdef USE_environ

      ___shell_mod.environ_unused_at_end = 0;
      ___shell_mod.environ_was_extended = 0;

#endif

      ___shell_mod.setup = 1;
      return ___FIX(___NO_ERR);
    }

  return ___FIX(___UNKNOWN_ERR);
}


void ___cleanup_shell_module ___PVOID
{
  if (___shell_mod.setup)
    {
#ifdef USE_environ

      if (___shell_mod.environ_was_extended)
        ___free_mem (environ);

#endif

      ___shell_mod.setup = 0;
    }
}


/*---------------------------------------------------------------------------*/