Program ssl_client;	// Minimal SSLeay client for Virtual Pascal
uses Use32, SSLeay32, LIBeay32, Strings, VPSysLow;

const
  host			: PChar = 'localhost:4321';
  p			: Array[0..18] of Char = 'GET / HTTP 1.0'#13#10#13#10#0;

var
  ctx			: SSL_CTX;
  s			: SSL;
  out,filter		: BIO;
  ciph			: SSL_CIPHER;
  len,off,i,bits	: Integer;
  okay			: Boolean;
  buf			: Array[0..4095] of Byte;

label err;

begin
  WriteLn(' SSL Client Test Program ');
  WriteLn('=========================');

  SSL_load_error_strings;	       // load the error messages

  SSLeay_add_ssl_algorithms;	       // Setup all the global SSL stuff

  ctx := SSL_CTX_new(SSLv23_client_method);

  s := SSL_new(ctx);			// Make a SSL structure
  SSL_set_connect_state(s);

  filter := BIO_new(BIO_f_ssl); 	// Use it inside a SSL BIO
  BIO_set_ssl(filter,s,BIO_CLOSE);

  out := BIO_new(BIO_s_connect);	// Lets use a connect BIO under the SSL BIO
  BIO_set_conn_hostname(out,host);
  BIO_set_nbio(out,1);			// Set non-blocking mode
  out := BIO_push(filter,out);

  okay := False;

  len := StrLen(p);

  off := 0;
  repeat
    i := BIO_write(out,p[off],len);
    if i<=0 then begin
      if BIO_should_retry(out) then begin
	//BIO_puts(stderr,'write DELAY'#13#10);
	BIO_puts(stderr,'.');
	SysCtrlSleep(1{000});
	continue;
      end else goto err;
    end;
    inc(off,i);
    dec(len,i);
  until len<=0;
  BIO_puts(stderr,#13#10);

  ciph := SSL_get_current_cipher(s); bits := 0;
  SSL_CIPHER_get_bits(ciph,bits);

  repeat
    i := BIO_read(out,buf,SizeOf(buf));
    if i = 0 then break;
    if i<0 then begin
      if BIO_should_retry(out) then begin
	//BIO_puts(stderr,'read DELAY'#13#10);
	BIO_puts(stderr,'#');
	SysCtrlSleep(1{000});
	continue;
      end else goto err;
    end;
    BIO_write(stdout,buf,i);
  until false;

  okay := True;
  err:
  if not okay then begin
    if ERR_peek_error = 0 then begin   // System Call Error
      // bugger!
    end else
      ERR_print_errors(stderr);
  end else begin
    writeln(' Encryption Bits : ',bits);
  end;

  BIO_free_all(out);
  if ctx<>nil then SSL_CTX_free(ctx);

end.

