* Fix errors, download now works

git-svn-id: trunk@40786 -

packages/gnutls/examples/httpget.pp

@@ -1,16 +1,22 @@
 program httpget;
+
 {$mode objfpc}
 {$h+}
-uses ssockets, gnutls;
+
+uses sysutils, ssockets, gnutls, uriparser;
 
 Const
-  MAX_BUF = 1024*256;
-  MSG = 'GET / HTTP/1.0'#13#10#13#10;
+  logLevel = 0; // Set to positive value to enable logging.
+  // Correct this for your system.
   DefaultCerts : PChar =  '/etc/ssl/certs/ca-certificates.crt';
 
+  MAX_BUF = 1024*256;
+  MSG = 'GET %s HTTP/1.0'#13#10'Host: %s'#13#10#13#10;
+
+
 Procedure MyLogFunc(level : longint; msg : PChar); cdecl;
 begin
-  writeln('Log[',Level:2,']: ',msg);
+  writeln(StdErr,'Log[',Level:2,']: ',msg);
 end;
 
 Var
@@ -20,14 +26,30 @@ Var
   buf : Array[0..MAX_BUF] of char;
   cred : tgnutls_certificate_credentials_t;
   errptr,desc : pchar;
-  S : String;
-  HostName : String;
+  FN, URL,S, HostName : String;
   port : word;
-      
+
+  uri : TURI;
+
 begin
-  hostname:='www.freepascal.org';
-//  hostname:='www.google.be';
-  port:=443;
+  if paramCount<1 then
+    begin
+    writeln('Usage : ',ExtractFileName(ParamStr(0)),' url');
+    Halt(1);
+    end;
+  url:=ParamStr(1);
+  uri:=ParseURI(URL,'https',443);
+  hostname:=uri.Host;
+  if uri.Protocol<>'https' then
+    begin
+    Writeln('Only https supported');
+    Halt(1);
+    end;
+  Port:=URI.Port;
+  FN:=uri.Path+URI.Document;
+  if (URI.Params<>'') then
+    FN:=FN+'?'+URI.Params;
+  if FN='' then FN:='/';
   LoadGNutls();
   gnutls_global_init();
   ret := gnutls_certificate_allocate_credentials (@cred);
@@ -48,12 +70,15 @@ begin
 	     gnutls_strerror(ret));
     halt(1);
     end;
-  gnutls_global_set_log_function(@MyLogFunc);
-  gnutls_global_set_log_level(5);
+  if (logLevel>0) then
+    begin
+    gnutls_global_set_log_function(@MyLogFunc);
+    gnutls_global_set_log_level(logLevel);
+    end;
   gnutls_init(@session, GNUTLS_CLIENT);
 //  gnutls_priority_set_direct(session,'PERFORMANCE:+ANON-ECDH:+ANON-DH',Nil);
-  ret:=gnutls_set_default_priority(session);
-//  ret := gnutls_priority_set_direct(session, 'SECURE256', @errptr);
+//  ret:=gnutls_set_default_priority(session);
+  ret := gnutls_priority_set_direct(session, 'NORMAL', @errptr);
   if (ret <> GNUTLS_E_SUCCESS) then
     begin
     writeln(stderr, 'error: gnutls_priority_set_direct: ',gnutls_strerror(ret) , ' error: at: ', errptr);
@@ -70,6 +95,7 @@ begin
   Sock:=TINetSocket.Create(HostName,Port);
   gnutls_transport_set_int(session, Sock.Handle);
   gnutls_handshake_set_timeout(session,GNUTLS_DEFAULT_HANDSHAKE_TIMEOUT);
+
   ret := gnutls_server_name_set(session, GNUTLS_NAME_DNS,pchar(HostName), length(HostName));
   if (ret <> GNUTLS_E_SUCCESS) then
     begin
@@ -81,7 +107,14 @@ begin
   
   Repeat
     ret:=gnutls_handshake(session);
-  until (ret>0)  or (gnutls_error_is_fatal(ret) <> 0);
+    if Ret<>GNUTLS_E_SUCCESS then
+      Case ret of
+        GNUTLS_E_AGAIN : Writeln(StdErr,'Handshake again');
+        GNUTLS_E_INTERRUPTED : Writeln(StdErr,'Handshake interrupted');
+      else
+        Writeln(StdErr,'Error ',ret,' received, fatal : ',gnutls_error_is_fatal(ret));
+      end;
+  until (ret>=0)  or (gnutls_error_is_fatal(ret) <> 0);
   if (ret < 0) then
     begin
     writeln(stderr, '*** Handshake failed');
@@ -90,25 +123,29 @@ begin
   else  
     begin
     desc := gnutls_session_get_desc(session);
-    writeln('- Session info: ', desc);
+    writeln(StdErr,'- Session info: ', desc);
 //    gnutls_free(desc);
     end;
-  gnutls_record_send(session, @MSG[1], length(MSG));
-  ret := gnutls_record_recv(session, @buf, MAX_BUF);
-  if (ret=0) then
-    writeln('- Peer has closed the TLS connection\n')
-  else if ((ret < 0) and (gnutls_error_is_fatal(ret) = 0)) then
-    writeln(stderr, '*** Warning: ', gnutls_strerror(ret))
-  else if (ret < 0) then
-    Writeln(stderr, '*** Error: ', gnutls_strerror(ret))
-  else if (ret > 0) then
-      begin
-      writeln('- Received %d bytes: ', ret);
-      SetLength(S,Ret);
-      Move(Buf[0],S[1],Ret);
-      Writeln(S);
-      gnutls_bye(session, GNUTLS_SHUT_RDWR);
-      end;
+  S:=Format(Msg,[FN,HostName]);
+  Writeln(StdErr,'Sending request : ',S);
+  gnutls_record_send(session, Pchar(S), length(S));
+  repeat
+    ret := gnutls_record_recv(session, @buf, MAX_BUF);
+    if (ret=0) then
+      writeln(StdErr,'- Peer has closed the TLS connection\n')
+    else if ((ret < 0) and (gnutls_error_is_fatal(ret) = 0)) then
+      writeln(stderr, '*** Warning: ', gnutls_strerror(ret))
+    else if (ret < 0) then
+      Writeln(stderr, '*** Error: ', ret, ' : ',gnutls_strerror(ret), ' ',(ret=GNUTLS_E_INTERRUPTED) or (Ret=GNUTLS_E_AGAIN))
+    else if (ret > 0) then
+        begin
+        writeln(StdErr,'- Received ',ret,' bytes: ');
+        SetLength(S,Ret);
+        Move(Buf[0],S[1],Ret);
+        Writeln(S);
+        end;
+  until (ret<=0) and Not ((ret=GNUTLS_E_INTERRUPTED) or (Ret=GNUTLS_E_AGAIN));
+  gnutls_bye(session, GNUTLS_SHUT_RDWR);
   Sock.Free;
   gnutls_deinit(session);
   gnutls_certificate_free_credentials(cred);