/*****************************************************************************/
/*
                               SesolaNet.c

SSL network connection establishment, read/write and other functions.

The SesolaNetRequest..() functions deal with SSL acceptance and SSL rundown of
requests to SSL services (i.e. via "https:").

The SesolaNetClient..() functions deal with initiation and rundown of an SSL
transaction with a remote SSL server.  This is sometimes refered to as HTTP to
SSL gatewaying, and should not be confised with the processing of peer
certificate which is also refered to as client processing sometimes.


VERSION HISTORY
---------------
07-JUN-2023  MGD  bugfix; SSL v1.3 requires SSL_CTX_set_ciphersuites()
08-AUG-2020  MGD  keep connect cert (->VerifyPeer) distinct from client cert
01-AUG-2020  MGD  bugfix; SesolaNetFree() ensure (sigh) X509_free() where
                    ->ClientCertPtr associated with connection (i.e. HTTP/2)
02-MAR-2020  MGD  SesolaNetBegin/Accept/End() refinements
19-JAN-2020  MGD  more proxy persistent connection (per JPP)
18-OCT-2019  MGD  bugfix; SesolaNetClientBegin() SESOLA_SINCE_110
                    BIO_set_data() before SSL_set_bio() (per JPP)
18-APR-2018  MGD  SesolaNetBegin() return success/failure
16-MAR-2017  MGD  further refinements supporting OpenSSL v1.1.0 and TLS 1.3
30-DEC-2016  MGD  SesolaNetThisIsSSL() allow redirection to include scheme
03-AUG-2016  MGD  OpenSSL v1.1.0(-pre6) required code changes including
                    #if (OPENSSL_VERSION_NUMBER < 0x10100000L) compilation
11-AUG-2015  MGD  restructure of network I/O abstractions
                  SesolaNetThisIsSSL() simplify by removing request URI
13-JUN-2015  MGD  disable kludge; SesolaNetAccept() SSL3_ST_SR_CLNT_HELLO_C
                    as the issue seems to have been fixed in OpenSSL v1.0.2c
20-FEB-2015  MGD  SesolaNetAccept() SSL3_ST_SR_CLNT_HELLO_C in v1.0.2a
                  bugfix; #if..#endif nesting of kludge described below
02-FEB-2015  MGD  kludge; SesolaNetAccept() SSL3_ST_SR_CLNT_HELLO_C
29-JAN-2015  MGD  bugfix; SesolaNetClientBegin() ambiguous WatchThis(SNI)
11-NOV-2014  MGD  SesolaNetAccept() collect version, cipher, cached
04-OCT-2013  MGD  SesolaNetThisIsSSL() support [ServiceNonSSLRedirect]
03-AUG-2013  MGD  SesolaNetClientBegin() include SNI before connect
28-APR-2012  MGD  bugfix; SesolaNetAccept() initialise value=0
                  bugfix; SesolaNetRead() SSL state not SSL_ST_OK
                  bugfix; SesolaNetWrite() SSL state not SSL_ST_OK
04-SEP-2010  MGD  Sesola_read_ast() extend HTTP methods check
18-JUL-2010  MGD  bugfix; SSL_set_info_callback() not SSL_CTX_set..()
25-APR-2008  MGD  increase sanity check error count from 255 to 8192
12-APR-2006  MGD  bugfix; SSL_shutdown() problem reported by JPP
                    introduce SesolaNetReadAst() and SesolaNetWriteAst()
                    to defer reset of AST function address used to indicate
                    AST-in-progress in other parts of the code
10-JUN-2005  MGD  make EXQUOTA (particularly ASTLM) a little more obvious
14-APR-2005  MGD  bugfix; SesolaNetClientShutdown() remove SSL_shutdown()
                  (revealed by ->https: tunnelling shutdown)
21-DEC-2004  MGD  bugfix; obscure in Sesesol_read() and Sesola_Write()
                  when WATCHing via SSL due to undereferenced NULL 'rqptr'
17-DEC-2004  MGD  bugfix; Sesola_read_ast() and Sesola_write_ast()
                  zero I/O status block count on error status
14-DEC-2004  MGD  remove BIO_set_retry_..() BIO_clear_retry_..(),
                  add some sanity checking around reads and writes
17-NOV-2004  MGD  bugfix; SesolaNetRead() and SesolaNetWrite() if no I/O
                  and hence no defered AST reset defered AST function pointer
                  (thanks to jpp@esme.fr for isolating this during BETA)
27-OCT-2004  MGD  SesolaNetInProgress() raw I/O in progress? (for ProxyEnd())
21-AUG-2004  MGD  significant refinements to SSL processing
22-JUL-2004  MGD  changes to SSL shutdown, SesolaNetEnd() to allow
                  persistent connections over SSL for HTTP/1.1 (and general
                  SSL performance improvements - long overdue)
29-JAN-2003  MGD  bugfix; error recovery in Sesola_read() and Sesola_write()
18-APR-2002  MGD  bugfix; service and client SSL contexts
26-FEB-2002  MGD  bugfix; SesolaNetRequestEnd() wait for blocking I/O
08-JAN-2002  MGD  rework SESOLA.C
*/
/*****************************************************************************/

#ifdef WASD_VMS_V7
#undef _VMS__V6__SOURCE
#define _VMS__V6__SOURCE
#undef __VMS_VER
#define __VMS_VER 70000000
#undef __CRTL_VER
#define __CRTL_VER 70000000
#endif

/* standard C header files */
#include <ctype.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

/* VMS related header files */
#include <iodef.h>
#include <ssdef.h>
#include <stsdef.h>

/* application header files */
#define SESOLA_REQUIRED
#include "Sesola.h"

#define WASD_MODULE "SESOLANET"

/***************************************/
#ifdef SESOLA  /* secure sockets layer */
/***************************************/

#define SET_RECEIVED_SHUTDOWN 1

/******************/
/* global storage */
/******************/

int  SesolaNetEndCount,
     SesolaNetFailCount,
     SesolaNetFreeCount,
     SesolaNetNewCount,
     SesolaNetProblemCount,
     SesolaNetShutCount,
     SesolaNetShut0Count,
     SesolaNetShut1Count,
     SesolaNetShutChanCount,
     SesolaNetShutReadCount,
     SesolaNetShutWriteCount;

/* FYI only - opaque after OpenSSL v1.1.0 */
struct bio_method_struct
{
    int type;
    const char *name;
    int (*bwrite_conv) (BIO *, const char *, int);
    int (*bwrite) (BIO *, const char *, int);
    int (*bread_conv) (BIO *, char *, int);
    int (*bread) (BIO *, char *, int);
    int (*bputs) (BIO *, const char *);
    int (*bgets) (BIO *, char *, int);
    long (*ctrl) (BIO *, int, long, void *);
    int (*create) (BIO *);
    int (*destroy) (BIO *);
    long (*callback_ctrl) (BIO *, int, bio_info_cb *);
};

/********************/
/* external storage */
/********************/

extern int  EfnWait,
            EfnNoWait,
            NetReadBufferSize,
            SesolaSNI,
            SesolaSSLversion;

extern char  *SesolaDefaultCertPtr,
             *SesolaDefaultCipherListPtr,
             *SesolaDefaultKeyPtr;

extern char  ErrorSanityCheck[],
             SoftwareID[];

extern ACCOUNTING_STRUCT  *AccountingPtr;
extern WATCH_STRUCT  Watch;

/*****************************************************************************/
/*
Begin an SSL transaction for a request.  Create the Sesola structure used to
store HTTPd SSL-related used during the transaction, initialize the OpenSSL
structures required, then begin the OpenSSL accept functionality.

RequestAccept() and RequestBegin() ensure the client has supplied data to begin
the handshake (by using NetIoPeek()) before this function is called.  OpenSSL
v1.0.n would occasionally barf when SSL_free()ing if the client had written no
data (test case: "telnet <host> 443" left to timeout).
*/

void SesolaNetBegin (REQUEST_STRUCT *rqptr)

{
   int  value;
   SERVICE_STRUCT  *svptr;
   SESOLA_STRUCT  *sesolaptr;

   /*********/
   /* begin */
   /*********/

   if (WATCHMOD (rqptr, WATCH_MOD_SESOLA))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_SESOLA, "SesolaNetBegin()");

   /* note that this IS NOT HEAP memory, and must be explicitly VmFree()d */
   sesolaptr = (SESOLA_STRUCT*)VmGet (sizeof(SESOLA_STRUCT));

   sesolaptr->RequestPtr = rqptr;
   sesolaptr->NetIoPtr = rqptr->NetIoPtr;
   rqptr->NetIoPtr->SesolaPtr = sesolaptr;

   if (!((SESOLA_CONTEXT*)rqptr->ServicePtr->SSLserverPtr)->SslCtx)
   {
      SesolaNetProblemCount++;
      ErrorNoticed (rqptr, 0, "SslCtx == NULL", FI_LI);
      if (WATCHING (rqptr, WATCH_SESOLA))
         WatchThis (WATCHITM(rqptr), WATCH_SESOLA, "BEGIN SSL context NULL");
      SesolaNetBeginFail (sesolaptr);
      return;
   }

   svptr = sesolaptr->NetIoPtr->ServicePtr;
   sesolaptr->SslCtx = (SSL_CTX*)((SESOLA_CONTEXT*)svptr->SSLserverPtr)->SslCtx;

   if (rqptr->NetIoPtr->WatchItem)
   {
      char  *cptr;
      if (cptr = SesolaMemTrackReport())
         WatchThis (WATCHALL, WATCH_SESOLA, "MEMORY !AZ", cptr);
   }

   sesolaptr->SslPtr = SSL_new (sesolaptr->SslCtx);
   if (!sesolaptr->SslPtr)
   {
      SesolaNetProblemCount++;
      ErrorNoticed (rqptr, 0, "SSL_new() failed", FI_LI); 
      if (WATCHING (rqptr, WATCH_SESOLA))
         WatchThis (WATCHITM(rqptr), WATCH_SESOLA, "BEGIN SSL_new() failed");
      SesolaNetBeginFail (sesolaptr);
      return;
   }
   SesolaNetNewCount++;

   SSL_set_app_data (sesolaptr->SslPtr, sesolaptr);

   sesolaptr->BioPtr = BIO_new (BIO_s_Sesola());
   if (!sesolaptr->BioPtr)
   {
      SesolaNetProblemCount++;
      ErrorNoticed (rqptr, 0, "BIO_new() failed", FI_LI); 
      if (WATCHING (rqptr, WATCH_SESOLA))
         WatchThis (WATCHITM(rqptr), WATCH_SESOLA, "BEGIN BIO_new() failed");
      SesolaNetBeginFail (sesolaptr);
      return;
   }

   BIO_set_data (sesolaptr->BioPtr, sesolaptr);
   SSL_set0_rbio (sesolaptr->SslPtr, sesolaptr->BioPtr);
   SSL_set0_wbio (sesolaptr->SslPtr, sesolaptr->BioPtr);

   SSL_set_accept_state (sesolaptr->SslPtr);

#if WATCH_CAT
   if (WATCHING (rqptr, WATCH_SESOLA))
   {
      WatchThis (WATCHITM(rqptr), WATCH_SESOLA, "BEGIN !AZ",
                 SesolaProtocolVersion (sesolaptr->SslCtx));
      /* set for SSL information and verification callback */
      SSL_set_ex_data (sesolaptr->SslPtr, 0, sesolaptr);
      SSL_set_info_callback (sesolaptr->SslPtr, &SesolaWatchInfoCallback);

      /* set for BIO callback with the request pointer as it's argument */
      BIO_set_callback (sesolaptr->BioPtr, &SesolaWatchBioCallback);
      BIO_set_callback_arg (sesolaptr->BioPtr, sesolaptr);
   }
#endif

   /* begin the SSL handshake */
   SesolaNetAccept (sesolaptr);
}

/*****************************************************************************/
/*
Either SesolaNetBegin() or SesolaNetAccept() have failed in some way, the
TLS/SSL negotiation has not occured, the TLS/SSL connection is not established
and the request has not got underway.  Shut down the request in as economical
way as possible.
*/

void SesolaNetBeginFail (SESOLA_STRUCT *sesolaptr)

{
   REQUEST_STRUCT  *rqptr;

   /*********/
   /* begin */
   /*********/

   rqptr = sesolaptr->RequestPtr;

   if (WATCHMOD (rqptr, WATCH_MOD_SESOLA))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_SESOLA, "SesolaNetBeginFail()");

   if (WATCHING (rqptr, WATCH_CONNECT))
      WatchThis (WATCHITM(rqptr), WATCH_CONNECT, "CLOSE !AZ,!UL !AZ",
                 rqptr->ClientPtr->Lookup.HostName,
                 rqptr->ClientPtr->IpPort, 
                 rqptr->ServicePtr->ServerHostPort); 

   /* this will be reset to zero by the next successful TLS accept */
   if (SesolaNetProblemCount > SESOLA_NET_PROBLEM_MAX)
   {
      char  buf [32];
      sprintf (buf, "%d successive TLS failures", SesolaNetProblemCount);
      ErrorExitVmsStatus (SS$_ABORT, buf, FI_LI);
   }
   
   SesolaNetFailCount++;

   rqptr->NetIoPtr->SesolaPtr = NULL;

   SesolaNetFree (sesolaptr);

   InstanceMutexLock (INSTANCE_MUTEX_HTTPD);
   NetUpdateConnected (rqptr, -1);
   InstanceMutexUnLock (INSTANCE_MUTEX_HTTPD);

   RequestEnd4 (rqptr);
}

/*****************************************************************************/
/*
This establishes the connection with an SSL client by providing the server
"hello", certificate and key exchange, etc.  Due to the non-blocking I/O used
by WASD this function will be called multiple times to complete the OpenSSL
accept.
*/

SesolaNetAccept (SESOLA_STRUCT *sesolaptr)

{
   int  error = 0,
        value = 0;
   REQUEST_STRUCT  *rqptr;
   SESOLA_CONTEXT  *scptr;
   SSL_SESSION  *SessionPtr;

   /*********/
   /* begin */
   /*********/

   rqptr = sesolaptr->RequestPtr;

   if (WATCH_MODULE (WATCH_MOD_SESOLA))
      WatchThis (WATCHALL, WATCH_MOD_SESOLA,
                 "SesolaNetAccept() !&F !UL !&B !&B !&B !&S", &SesolaNetAccept,
                 sesolaptr->SslAcceptCount,
                 sesolaptr->HTTPduringHandshake,
                 sesolaptr->SSHduringHandshake,
                 rqptr->NetIoPtr->ServicePtr->ShareSSH,
                 sesolaptr->ReadIOsb.Status);

   sesolaptr->SslStateFunction = &SesolaNetAccept;

   ERR_clear_error ();
   value = SSL_accept (sesolaptr->SslPtr);

   if (WATCHMOD (rqptr, WATCH_MOD_SESOLA))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_SESOLA,
                 "SSL_accept() !SL !SL",
                 value, SSL_get_error(sesolaptr->SslPtr,value));

   /* just a sanity check on the SSL_accept() activity */
   if (sesolaptr->SslAcceptCount++ > SESOLA_SSL_ACCEPT_MAX)
   {
      if (rqptr->NetIoPtr->Channel)
      {
         /* break the connection */
         sys$dassgn (rqptr->NetIoPtr->Channel);
         rqptr->NetIoPtr->Channel = 0;
      }
      value = -1;
   }

   /* if non-blocking IO in progress just return and wait for delivery */
   if (sesolaptr->ReadInProgress || sesolaptr->WriteInProgress) return;

   sesolaptr->SslStateFunction = NULL;

   if (sesolaptr->HTTPduringHandshake)
      SesolaNetThisIsSSL (sesolaptr);
   else
   if (rqptr->NetIoPtr->ServicePtr->ShareSSH)
   {
      if (sesolaptr->SSHduringHandshake ||
          sesolaptr->ReadIOsb.Status == SS$_CANCEL)
      {
         SesolaNetFree (sesolaptr);
         rqptr->NetIoPtr->SesolaPtr = NULL;
         RequestShareBegin (rqptr);
         return;
      }
   }

   if (value < 0)
   {
      /**********/
      /* retry? */
      /**********/

      error = SSL_get_error (sesolaptr->SslPtr, value);
      if (error != SSL_ERROR_WANT_CLIENT_HELLO_CB)
      {
         SesolaNetBeginFail (sesolaptr);
         return;
      }

      if (WATCHING (rqptr, WATCH_SESOLA))
      {
         WatchThis (WATCHITM(rqptr), WATCH_SESOLA, "BEGIN retry");
         SesolaWatchErrors (rqptr);
      }
      return;
   }

   if (value == 0)
   {
      /********/
      /* fail */
      /********/

      if (WATCHING (rqptr, WATCH_SESOLA))
      {
         WatchThis (WATCHITM(rqptr), WATCH_SESOLA, "BEGIN failed");
         SesolaWatchErrors (rqptr);
      }

      SesolaNetBeginFail (sesolaptr);
      return;
   }

   /***********/
   /* TLS/SSL */
   /***********/

   switch (SSL_version (sesolaptr->SslPtr))
   {
      case TLS1_3_VERSION :
         InstanceGblSecIncrLong (&AccountingPtr->ConnectTLS13Count);
         break;
      case TLS1_2_VERSION :
         InstanceGblSecIncrLong (&AccountingPtr->ConnectTLS12Count);
         break;
      case TLS1_1_VERSION :
         InstanceGblSecIncrLong (&AccountingPtr->ConnectTLS11Count);
         break;
      case TLS1_VERSION :
         InstanceGblSecIncrLong (&AccountingPtr->ConnectTLS1Count);
         break;
      case SSL3_VERSION :
         InstanceGblSecIncrLong (&AccountingPtr->ConnectSSL3Count);
         break;
   }

   scptr = sesolaptr->NetIoPtr->ServicePtr->SSLserverPtr;
   if (scptr->VerifyPeer)
      sesolaptr->ConnectCertPtr = SSL_get_peer_certificate (sesolaptr->SslPtr);
   else
      sesolaptr->ClientCertPtr = SSL_get_peer_certificate (sesolaptr->SslPtr);

   if (WATCHING (rqptr, WATCH_SESOLA))
      SesolaWatchSession (sesolaptr);

   if (WATCHMOD (rqptr, WATCH_MOD_SESOLA))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_SESOLA,
                 "->ClientCertPtr !&X", sesolaptr->ClientCertPtr);

   SesolaNetProblemCount = 0;

   RequestBegin (rqptr);
}

/*****************************************************************************/
/*
Shutdown the SSL session with the client (elegantly if we can!).
Once kicked off this function becomes autonomous, eventually deassigning the
socket and freeing both the network I/O structure and itself.  The calling
routine can just continue on its way.
*/

void SesolaNetEnd (SESOLA_STRUCT *sesolaptr)

{
   int  error, sanity, value;
   NETIO_STRUCT  *ioptr;

   /*********/
   /* begin */
   /*********/

   ioptr = sesolaptr->NetIoPtr;

   if (WATCHMOD (ioptr, WATCH_MOD_SESOLA))
      WatchThis (WATCHITM(ioptr), WATCH_MOD_SESOLA,
"SesolaNetEnd() !&F shut:!UL chan:!UL count:!UL \
read:%X!8XL AST:!&A inprog:!SL write:%X!8XL AST:!&A inprog:!SL",
                  &SesolaNetEnd,
                  SSL_get_shutdown(sesolaptr->SslPtr),
                  ioptr->Channel, sesolaptr->SslShutdownCount,
                  ioptr->ReadStatus, ioptr->ReadAstFunction,
                  sesolaptr->ReadInProgress,
                  ioptr->WriteStatus, ioptr->WriteAstFunction,
                  sesolaptr->WriteInProgress);

   if (sesolaptr->SslStateFunction &&
       sesolaptr->SslStateFunction != &SesolaNetEnd)
   {
      /* original SSL_accept() has not completed */
      if (WATCHING (ioptr, WATCH_SESOLA))
         WatchThis (WATCHITM(ioptr), WATCH_SESOLA, "BEGIN failed");
      sys$dassgn (ioptr->Channel);
      ioptr->Channel = 0;
   }

   if (sesolaptr->SslStateFunction != &SesolaNetEnd) SesolaNetEndCount++;

   /* everything (now) is coming here! */
   sesolaptr->SslStateFunction = &SesolaNetEnd;

   if (ioptr->Channel)
   {
      /* socket is still available */
      SesolaNetShutChanCount++;
      /* these are still usable status (VCCLOSED occurs with HTTP/2) */
      if (ioptr->ReadStatus == SS$_CANCEL ||
          ioptr->ReadStatus == SS$_VCCLOSED) ioptr->ReadStatus = SS$_NORMAL;
      if (ioptr->WriteStatus == SS$_CANCEL ||
          ioptr->WriteStatus == SS$_VCCLOSED) ioptr->WriteStatus = SS$_NORMAL;
   }

   if (ioptr->Channel)
   {
      if (sesolaptr->SslShutdownCount++ < SESOLA_SSL_SHUTDOWN_MAX)
      {
         if (sesolaptr->SslShutdownCount == 1)
            if (WATCHING (ioptr, WATCH_SESOLA))
               WatchThis (WATCHITM(ioptr), WATCH_SESOLA, "SHUTDOWN");

#if SET_RECEIVED_SHUTDOWN
         /* not going to wait for the peer to respond */
         SSL_set_shutdown (sesolaptr->SslPtr, SSL_RECEIVED_SHUTDOWN);
#endif

         for (sanity = value = 0; sanity < 5 && value == 0; sanity++)
         {
            ERR_clear_error ();
            value = SSL_shutdown (sesolaptr->SslPtr);

            if (WATCHMOD (ioptr, WATCH_MOD_SESOLA))
               WatchThis (WATCHITM(ioptr), WATCH_MOD_SESOLA,
                           "SSL_shutdown() !SL !SL",
                           value, SSL_get_error(sesolaptr->SslPtr,value));

            if (value == 1)
               SesolaNetShut1Count++;
            else
            if (value == 0)
               SesolaNetShut0Count++;
            else
               SesolaNetShutCount++;
         }

         if (sesolaptr->ReadInProgress) SesolaNetShutReadCount++;
         if (sesolaptr->WriteInProgress) SesolaNetShutWriteCount++;
      }
      else
      {
         /* sanity check, so knock the socket on the head */
         sys$dassgn (ioptr->Channel);
         ioptr->Channel = 0;
         ErrorNoticed (NULL, SS$_BUGCHECK, "SESOLA_SSL_SHUTDOWN_MAX", FI_LI); 
      }
   }

   if (WATCHMOD (ioptr, WATCH_MOD_SESOLA))
      WatchThis (WATCHITM(ioptr), WATCH_MOD_SESOLA, "reading:!SL writing:!SL",
                  sesolaptr->ReadInProgress, sesolaptr->WriteInProgress);

   /* intercept any outstanding I/O */
   if (sesolaptr->ReadInProgress || sesolaptr->WriteInProgress) return;

   if (WATCHING (ioptr, WATCH_SESOLA))
      WatchThis (WATCHITM(ioptr), WATCH_SESOLA, "END");

   if (WATCHING (ioptr, WATCH_CONNECT))
      WatchThis (WATCHITM(ioptr), WATCH_CONNECT, "CLOSE !AZ,!UL !AZ",
                 ioptr->ClientPtr->Lookup.HostName,
                 ioptr->ClientPtr->IpPort, 
                 ioptr->ServicePtr->ServerHostPort); 

   if (ioptr->Channel) sys$dassgn (ioptr->Channel);

   VmFree (ioptr, FI_LI);

   SSL_set_shutdown (sesolaptr->SslPtr, SSL_SENT_SHUTDOWN);
   SSL_set_shutdown (sesolaptr->SslPtr, SSL_RECEIVED_SHUTDOWN);

   SesolaNetFree (sesolaptr);
}

/*****************************************************************************/
/*
Free the OpenSSL structures outside of any use of them (early mistake)!
*/

void SesolaNetFree (SESOLA_STRUCT *sesolaptr)

{
   /*********/
   /* begin */
   /*********/

   if (WATCH_MODULE(WATCH_MOD_SESOLA))
      WatchThis (WATCHALL, WATCH_MOD_SESOLA, "SesolaNetFree()");

   if (sesolaptr->ClientCertPtr)
      X509_free (sesolaptr->ClientCertPtr);
   if (sesolaptr->ConnectCertPtr)
      X509_free (sesolaptr->ConnectCertPtr);

   if (sesolaptr->VerifyPeerDataSize)
      VmFree (sesolaptr->VerifyPeerDataPtr, FI_LI);

   if (sesolaptr->SslPtr) SSL_free (sesolaptr->SslPtr);

//   if (char* cptr = SesolaMemTrackReport())
//      WatchThis (WATCHALL, WATCH_SESOLA, "MEMORY !AZ", cptr);

   VmFree (sesolaptr, FI_LI);

   SesolaNetFreeCount++;
}

/*****************************************************************************/
/*
Some development/debug statistics.
*/

char* SesolaNetStats (void)

{
   static char  buf [96];

   /*********/
   /* begin */
   /*********/

   if (WATCH_MODULE(WATCH_MOD_SESOLA))
      WatchThis (WATCHALL, WATCH_MOD_SESOLA, "SesolaNetStats()");

   sprintf (buf, "new:%u end:%u free:%u fail:%u shut:%u/%u/%u/%u/%u/%u",
            SesolaNetNewCount, SesolaNetEndCount, SesolaNetFreeCount,
            SesolaNetFailCount, SesolaNetShutCount, SesolaNetShutChanCount,
            SesolaNetShut0Count, SesolaNetShut1Count, SesolaNetShutReadCount,
            SesolaNetShutWriteCount);
   return (buf);
}

/*****************************************************************************/
/*
Begin an SSL transaction.  Create the Sesola structure used to store HTTPd
SSL-related used during the transaction, initialize the OpenSSL structures
required, then begin the OpenSSL connect functionality.  Note that this is
proxy functionality and so proxy request rundown functions are used.
*/

SesolaNetClientBegin (PROXY_TASK *tkptr)

{
   int  value;
   REQUEST_STRUCT  *rqptr;
   SERVICE_STRUCT  *svptr;
   SESOLA_CONTEXT  *scptr;
   SESOLA_STRUCT  *sesolaptr;

   /*********/
   /* begin */
   /*********/

   if (WATCHMOD (tkptr, WATCH_MOD_SESOLA))
      WatchThis (WATCHITM(tkptr), WATCH_MOD_SESOLA,
                 "SesolaNetClientBegin()");

   rqptr = tkptr->RequestPtr;
   svptr = tkptr->ServicePtr;

   if (!svptr->SSLclientPtr)
   {
      if (WATCHING (rqptr, WATCH_SESOLA))
         WatchThis (WATCHITM(rqptr), WATCH_SESOLA, "CLIENT SSL not configured");
      ProxyEnd (tkptr);
      return;
   }

   if (!((SESOLA_CONTEXT*)svptr->SSLclientPtr)->SslCtx)
   {
      ErrorNoticed (rqptr, 0, "SslCtx == NULL", FI_LI);
      if (WATCHING (rqptr, WATCH_SESOLA))
         WatchThis (WATCHITM(rqptr), WATCH_SESOLA, "BEGIN SSL context NULL");
      ProxyEnd (tkptr);
      return;
   }

   /* note that this IS NOT HEAP memory, and must be explicitly VmFree()d */
   sesolaptr = (SESOLA_STRUCT*)VmGet (sizeof(SESOLA_STRUCT));
   tkptr->NetIoPtr->SesolaPtr = sesolaptr;
   sesolaptr->NetIoPtr = tkptr->NetIoPtr;
   sesolaptr->ProxyTaskPtr = tkptr;

   sesolaptr->SslPtr = SSL_new (((SESOLA_CONTEXT*)svptr->SSLclientPtr)->SslCtx);
   if (!sesolaptr->SslPtr)
   {
      if (WATCHING (tkptr, WATCH_SESOLA))
         WatchThis (WATCHITM(tkptr), WATCH_SESOLA,
                    "BEGIN SSL_new() failed");
      ErrorNoticed (rqptr, 0, "SSL_new() failed", FI_LI); 
      if (rqptr)
      {
         rqptr->rqResponse.HttpStatus = 500;
         ErrorGeneral (rqptr, MsgFor(rqptr,MSG_GENERAL_INTERNAL), FI_LI);
      }
      SesolaNetClientFree (tkptr);
      ProxyEnd (tkptr);
      return;
   }

   scptr = (SESOLA_CONTEXT*)svptr->SSLclientPtr;

   if (SSL_get_min_proto_version (sesolaptr->SslPtr) == TLS1_3_VERSION)
      value = SSL_set_ciphersuites (sesolaptr->SslPtr, scptr->CipherListPtr);
   else
      value = SSL_set_cipher_list (sesolaptr->SslPtr, scptr->CipherListPtr);
   if (!value)
   {
      if (WATCHING (tkptr, WATCH_SESOLA))
         WatchThis (WATCHITM(tkptr), WATCH_SESOLA,
                    "BEGIN SSL_set_cipher_..() failed");
      ErrorNoticed (rqptr, 0, "SSL_set_cipher_..() failed", FI_LI); 
      if (rqptr)
      {
         rqptr->rqResponse.HttpStatus = 500;
         ErrorGeneral (rqptr, MsgFor(rqptr,MSG_GENERAL_INTERNAL), FI_LI);
      }
      SesolaNetClientFree (tkptr);
      ProxyEnd (tkptr);
      return;
   }

   /* set the application data to point to the proxy task structure */
   SSL_set_app_data (sesolaptr->SslPtr, tkptr);

   sesolaptr->BioPtr = BIO_new (BIO_s_Sesola());
   if (!sesolaptr->BioPtr)
   {
      if (WATCHING (tkptr, WATCH_SESOLA))
         WatchThis (WATCHITM(tkptr), WATCH_SESOLA,
                    "BEGIN BIO_new() failed");
      ErrorNoticed (rqptr, 0, "BIO_new() failed", FI_LI); 
      if (rqptr)
      {
         rqptr->rqResponse.HttpStatus = 500;
         ErrorGeneral (rqptr, MsgFor(rqptr,MSG_GENERAL_INTERNAL), FI_LI);
      }
      SesolaNetClientFree (tkptr);
      ProxyEnd (tkptr);
      return;
   }

   BIO_set_data (sesolaptr->BioPtr, sesolaptr);
   SSL_set0_rbio (sesolaptr->SslPtr, sesolaptr->BioPtr);
   SSL_set0_wbio (sesolaptr->SslPtr, sesolaptr->BioPtr);

   SSL_set_connect_state (sesolaptr->SslPtr);

   /* Server Name Indication (SNI) */
   if (SesolaSNI)
   {
      /* if the SSL_get_servername() exists then this control should work */
      value = SSL_set_tlsext_host_name (sesolaptr->SslPtr,
                                        tkptr->RequestHostName);
      if (WATCHING (tkptr, WATCH_SESOLA))
         WatchThis (WATCHITM(tkptr), WATCH_SESOLA, "SNI !AZ!AZ",
                    tkptr->RequestHostName, value ? "" : " FAILED");
   }

   if (scptr->VerifyCA)
      SSL_set_verify (sesolaptr->SslPtr, SSL_VERIFY_CLIENT_ONCE,
                      &SesolaCertVerifyCallback);

   /* provide the sesola pointer for the verify callback */
   SSL_set_ex_data (sesolaptr->SslPtr, 0, sesolaptr);

#if WATCH_CAT
   if (WATCHING (rqptr, WATCH_SESOLA))
   {
      WatchThis (WATCHITM(rqptr), WATCH_SESOLA, "BEGIN !AZ",
                 SesolaProtocolVersion (sesolaptr->SslCtx));
      /* set for SSL information and verification callback */
      SSL_set_info_callback (sesolaptr->SslPtr, &SesolaWatchInfoCallback);
      /* set for BIO callback with the request pointer as it's argument */
      BIO_set_callback (sesolaptr->BioPtr, &SesolaWatchBioCallback);
      BIO_set_callback_arg (sesolaptr->BioPtr, sesolaptr);
   }
#endif

   /* associate the proxy task with the SSL structure */
   sesolaptr->ProxyTaskPtr = tkptr;

   /* begin the SSL handshake */
   SesolaNetClientConnect (sesolaptr);
}

/*****************************************************************************/
/*
This establishes the connection to an SSL server by providing the server
"hello", certificate and key exchange, etc.  Due to the non-blocking I/O used
by WASD this function will be called multiple times to complete the OpenSSL
connect. 
*/

SesolaNetClientConnect (SESOLA_STRUCT *sesolaptr)

{
   int  status,
        value;
   PROXY_TASK  *tkptr;
   REQUEST_STRUCT  *rqptr;

   /*********/
   /* begin */
   /*********/

   /* get the associate proxy task and request pointers */
   tkptr = sesolaptr->ProxyTaskPtr;
   rqptr = tkptr->RequestPtr;

   if (WATCHMOD (tkptr, WATCH_MOD_SESOLA))
      WatchThis (WATCHITM(tkptr), WATCH_MOD_SESOLA,
                 "SesolaNetClientConnect() !&F !UL", &SesolaNetClientConnect,
                 sesolaptr->SslConnectCount);

   sesolaptr->SslStateFunction = &SesolaNetClientConnect;

   /* just a sanity check on the SSL_connect() activity */
   if (sesolaptr->SslConnectCount++ < SESOLA_SSL_CONNECT_MAX)
   {
      if (sesolaptr->HTTPduringHandshake)
      {
         rqptr->rqResponse.HttpStatus = 501;
         ErrorGeneral (rqptr, MsgFor(rqptr,MSG_HTTP_501), FI_LI);
         SesolaNetClientFree (tkptr);
         ProxyEnd (tkptr);
         return;
      }

      value = SSL_connect (sesolaptr->SslPtr);

      if (WATCHMOD (tkptr, WATCH_MOD_SESOLA))
         WatchThis (WATCHITM(tkptr), WATCH_MOD_SESOLA,
                    "SSL_connect() !SL", value);

      /* if non-blocking IO in progress just return and wait for delivery */
      if (sesolaptr->ReadInProgress || sesolaptr->WriteInProgress) return;

      if (sesolaptr->HTTPduringHandshake)
      {
         rqptr->rqResponse.HttpStatus = 501;
         ErrorGeneral (rqptr, MsgFor(rqptr,MSG_HTTP_501), FI_LI);
         SesolaNetClientFree (tkptr);
         ProxyEnd (tkptr);
         return;
      }
   }

   /* can't free structures while non-blocking I/O still outstanding */
   if (sesolaptr->ReadInProgress || sesolaptr->WriteInProgress)
   {
      /* so knock the socket on the head */
      if (sesolaptr->NetIoPtr->Channel) ProxyNetCloseSocket (tkptr);
      return;
   }

   if (value <= 0)
   {
      /*********/
      /* error */
      /*********/

      if (WATCHING (rqptr, WATCH_SESOLA))
         SesolaWatchErrors (rqptr);

      if (rqptr)
      {
         rqptr->rqResponse.HttpStatus = 502;
         ErrorGeneral (rqptr, MsgFor(rqptr,MSG_HTTP_502), FI_LI);
      }
      SesolaNetClientFree (tkptr);
      ProxyEnd (tkptr);
      return;
   }

   if (WATCHING (tkptr, WATCH_SESOLA))
      SesolaWatchSession (sesolaptr);

   sesolaptr->SslStateFunction = NULL;

   if (tkptr->ProxyTunnel)
      ProxyTunnelBegin (tkptr);
   else
      ProxyWriteRequest (tkptr);
}

/*****************************************************************************/
/*
Shutdown the SSL session with the client (via an SSL alert so that we don't
wait around for a response!)  Return true if RequestEnd() can continue the
request run-down, false if has to abort and wait for some more to happen!
*/

SesolaNetClientShutdown (SESOLA_STRUCT *sesolaptr)

{
   int  value;
   PROXY_TASK  *tkptr;

   /*********/
   /* begin */
   /*********/

   tkptr = sesolaptr->ProxyTaskPtr;

   if (WATCHMOD (tkptr, WATCH_MOD_SESOLA))
      WatchThis (WATCHITM(tkptr), WATCH_MOD_SESOLA,
"SesolaNetClientShutdown() !&F !UL !UL !SL !SL", &SesolaNetClientShutdown,
                 sesolaptr->NetIoPtr->Channel, sesolaptr->SslShutdownCount,
                 sesolaptr->ReadInProgress, sesolaptr->WriteInProgress);

   /* everything is now going to be coming here! */
   sesolaptr->SslStateFunction = &SesolaNetClientShutdown;

   /* only provide explicit shutdown if still connected! */
   if (sesolaptr->NetIoPtr->Channel)
   {
      /* just a sanity check on the SSL_shutdown() activity */
      if (!sesolaptr->SslShutdownCount++)
      {
         if (WATCHING (tkptr, WATCH_SESOLA))
            WatchThis (WATCHITM(tkptr), WATCH_SESOLA, "SHUTDOWN");

         ERR_clear_error ();
         value = SSL_shutdown (sesolaptr->SslPtr);

         if (WATCHMOD (sesolaptr->NetIoPtr, WATCH_MOD_SESOLA))
            WatchThis (WATCHITM(sesolaptr->NetIoPtr), WATCH_MOD_SESOLA,
                        "SSL_shutdown() !SL !SL",
                        value, SSL_get_error(sesolaptr->SslPtr,value));
      }
      else
      if (sesolaptr->SslShutdownCount > SESOLA_SSL_SHUTDOWN_MAX)
      {
         /* sanity check, so knock the socket on the head */
         if (sesolaptr->NetIoPtr->Channel) ProxyNetCloseSocket (tkptr);
      }
   }

   /* intercept any outstanding I/O */
   if (sesolaptr->ReadInProgress || sesolaptr->WriteInProgress) return;

   if (WATCHING (tkptr, WATCH_SESOLA))
      WatchThis (WATCHITM(tkptr), WATCH_SESOLA, "END");

   SSL_set_shutdown (sesolaptr->SslPtr, SSL_SENT_SHUTDOWN);
   SSL_set_shutdown (sesolaptr->SslPtr, SSL_RECEIVED_SHUTDOWN);

   sesolaptr->SslStateFunction = NULL;

   SesolaNetClientFree (tkptr);

   ProxyEnd (tkptr);
}

/*****************************************************************************/
/*
Free the OpenSSL structures outside of any use of them (early mistake)!
*/

SesolaNetClientFree (PROXY_TASK *tkptr)

{
   int  value;
   SESOLA_STRUCT  *sesolaptr;

   /*********/
   /* begin */
   /*********/

   if (WATCHMOD (tkptr, WATCH_MOD_SESOLA))
      WatchThis (WATCHITM(tkptr), WATCH_MOD_SESOLA,
                 "SesolaNetClientFree()");

   sesolaptr = (SESOLA_STRUCT*)tkptr->NetIoPtr->SesolaPtr;

   if (sesolaptr->SslPtr) SSL_free (sesolaptr->SslPtr);

   VmFree (sesolaptr, FI_LI);

   tkptr->NetIoPtr->SesolaPtr = NULL;
}

/*****************************************************************************/
/*
Associate the proxy task with the SSL structure.  Needed when re-using a
persistent connection.
*/

void SesolaNetSetProxyTask (PROXY_TASK *tkptr)

{
   SESOLA_STRUCT  *sesolaptr;

   /*********/
   /* begin */
   /*********/

   if (WATCHMOD (tkptr, WATCH_MOD_SESOLA))
      WatchThis (WATCHITM(tkptr), WATCH_MOD_SESOLA,
                 "SesolaNetSetProxyTask()");

   sesolaptr = (SESOLA_STRUCT*)tkptr->NetIoPtr->SesolaPtr;

   sesolaptr->ProxyTaskPtr = tkptr;
}

/*****************************************************************************/
/*
Plain-text HTTP has been detected arriving on an SSL service.  Return either an
error message or redirect response (if configured).  The redirect parameter can
comprise an optional leading HTTP response code 301, 302, or 307 (default),
followed by an optional scheme ("http://" or "https://"), optional host name or
IP address, and optional port number (port must have leading colon if only
parameter), and even an optional URI.  The minimum parameter is a single colon,
which redirects to the same service name on port 80.  A 307 is used to indicate
to the agent that a non-GET should not be turned into one!  Something that
apparently commonly (incorrectly) happens with 302s.
*/

void SesolaNetThisIsSSL (SESOLA_STRUCT *sesolaptr)

{
   static char ThisIsSSLFao [] =
"HTTP/1.0 400 This is an SSL service!!\r\n\
Server: !AZ\r\n\
Content-Type: text/html\r\n\
\r\n\
400 error - This is an SSL service!!\n";

   static char  RedirectFao [] =
"HTTP/1.0 !UL Redirection\r\n\
Server: !AZ\r\n\
Location: !AZ://!AZ!AZ\r\n\
Content-Type: text/html\r\n\
\r\n\
!UL redirection - !AZ://!AZ!AZ\n";

   int  code, status;
   unsigned short  slen;
   char  *cptr, *pptr, *sptr, *zptr;
   char  NonSslRedirect [256],
         ResponseBuffer [4096];
   REQUEST_STRUCT  *rqptr;
   IO_SB  IOsb;

   /*********/
   /* begin */
   /*********/

   rqptr = sesolaptr->RequestPtr;

   if (WATCHMOD (rqptr, WATCH_MOD_SESOLA))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_SESOLA, "SesolaNetThisIsSSL()");

   if (!rqptr) return;

   for (cptr = rqptr->ServicePtr->NonSslRedirect; *cptr == ' '; cptr++);
   if (*cptr)
   {
      /************/
      /* redirect */
      /************/

      /* buffer the directive */
      for (cptr = rqptr->ServicePtr->NonSslRedirect; *cptr == ' '; cptr++);
      zptr = (sptr = NonSslRedirect) + sizeof(NonSslRedirect)-1;
      while (*cptr && sptr < zptr) *sptr++ = *cptr++;
      *sptr = '\0';
      cptr = NonSslRedirect;

      if (WATCHING (rqptr, WATCH_RESPONSE))
         WatchThis (WATCHITM(rqptr), WATCH_RESPONSE, "REDIRECT !AZ", cptr);

      /* optional HTTP response code - default is 307 */
      if (isdigit(*cptr))
      {
         code = atoi(cptr);
         if (code != 301 && code != 302 && code != 303) code = 307;
         while (*cptr && (isdigit(*cptr) || ISLWS(*cptr))) cptr++;
      }
      else
         code = 307;

      pptr = "http";
      sptr = "";
      if (*cptr == ':')
      {
         /* default to current service name */
         sptr = rqptr->ServicePtr->ServerHostName;
         /* if no trailing number then no port - default will be 80 */
         if (!isdigit(*(cptr+1))) cptr++;
      }
      else
      if (MATCH8 (cptr, "https://"))
      {
         pptr = "https";
         cptr += 8;
      }
      else
      if (MATCH7 (cptr, "http://"))
         cptr += 7;

      status = FaoToBuffer (ResponseBuffer, sizeof(ResponseBuffer)-1, &slen,
                            RedirectFao,
                            code, SoftwareID, pptr, sptr, cptr,
                            code, pptr, sptr, cptr);
      rqptr->rqResponse.HttpStatus = code;
   }
   else
   {
      /***********/
      /* message */
      /***********/

      status = FaoToBuffer (ResponseBuffer, sizeof(ResponseBuffer)-1, &slen,
                            ThisIsSSLFao, SoftwareID);
      rqptr->rqResponse.HttpStatus = 400;
   }

   if (VMSnok(status)) ErrorNoticed (rqptr, status, "FaoToBuffer()", FI_LI);

   /*******************/
   /* write to client */
   /*******************/

   if (WATCHPNT(rqptr) && (WATCH_CATEGORY(WATCH_RESPONSE_HEADER) ||
                           WATCH_CATEGORY(WATCH_RESPONSE_BODY)))
      WatchData (ResponseBuffer, slen);

   sys$qiow (EfnWait, sesolaptr->NetIoPtr->Channel,
             IO$_WRITEVBLK, &IOsb, 0, 0,
             ResponseBuffer, slen, 0, 0, 0, 0);
}

/*****************************************************************************/
/*
Implements a required function of a OpenSSL BIO_METHOD.
*/

BIO_METHOD *BIO_s_Sesola()

{
   static BIO_METHOD  *bmptr;

   /*********/
   /* begin */
   /*********/

   if (WATCH_MODULE(WATCH_MOD_SESOLA))
      WatchThis (WATCHALL, WATCH_MOD_SESOLA, "BIO_s_Sesola()");

   if (bmptr) return (bmptr);

   bmptr = BIO_meth_new (BIO_TYPE_NULL, "WASD Sesola");
   if (!bmptr) return (bmptr);

   BIO_meth_set_write_ex (bmptr, Sesola_netio_write_ex);
   BIO_meth_set_read_ex (bmptr, Sesola_netio_read_ex);
   BIO_meth_set_ctrl (bmptr, Sesola_ctrl);

   return (bmptr);
}

/*****************************************************************************/
/*
Implements a required function of a OpenSSL BIO_METHOD.
*/

long Sesola_ctrl
(
BIO *bioptr,
int Command,
long Number,
char *Pointer
)
{
   int  value;

   /*********/
   /* begin */
   /*********/

   if (WATCH_MODULE(WATCH_MOD_SESOLA))
      WatchThis (WATCHALL, WATCH_MOD_SESOLA, 
                 "Sesola_ctrl() !UL !UL !&X", Command, Number, Pointer);

   value = 1;
   switch (Command)
   {
      case BIO_CTRL_SET:
         BIO_set_init(bioptr, Number);
         return (1);

      case BIO_CTRL_EOF:
      case BIO_CTRL_FLUSH:
      case BIO_CTRL_RESET:
         return (1);

      case BIO_CTRL_SET_CLOSE:
      case BIO_CTRL_GET_CLOSE:
      case BIO_CTRL_DUP:
      case BIO_CTRL_INFO:
      case BIO_CTRL_GET:
      case BIO_CTRL_PENDING:
      case BIO_CTRL_POP:
      case BIO_CTRL_PUSH:
      case BIO_CTRL_WPENDING:
      default:
         return (0);
   }
}

/*****************************************************************************/
/*
For compilations without SSL these functions provide LINKage stubs for the
rest of the HTTPd modules, allowing for just recompiling the Sesola module to
integrate the SSL functionality.
*/

/*********************/
#else  /* not SESOLA */
/*********************/

/* external storage */
extern char  ErrorSanityCheck[];

SesolaNetBegin (REQUEST_STRUCT *rqptr)
{
   ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
}

SesolaNetClientBegin (PROXY_TASK *tkptr)
{
   ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
}

SesolaNetClientShutdown (void *sesolaptr)
{
   ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
}

SesolaNetEnd (void *sesolaptr)
{
   ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
}

SesolaNetSetProxyTask (PROXY_TASK *tkptr)
{
   ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
}

Sesola_read_ast (void *sesolaptr)
{
   ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
}

Sesola_write_ast (void *sesolaptr)
{
   ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
}

SesolaNetAccept (void *sesolaptr)
{
   ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
}

SesolaNetClientConnect (void *sesolaptr)
{
   ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
}

/************************/
#endif  /* ifdef SESOLA */
/************************/

/*****************************************************************************/

