subroutine netserver
      implicit integer*2(a-z)
      parameter (UNKNOW=0,GET=1,POST=2)
      parameter (WWW=0,PLAIN=1,DATA=2)
      character *512 buffer,cmdbuf,ucase
      character filename*(*)
      integer   cmd,contenttype,contentlength
      integer   fileunit,server,client
      common /serverdata/cmd,cmdbuf
      data server/0/,client/0/
      save server,client
      if(server.eq.0)server = init_server()
      write(6,*)'Server id= ',server
      return

      ENTRY requestclient
c        wacht op een client vraag 
         client = get_connect(server)
         if(client.lt.0)then
          write(6,*)'Error in Connect ',client,server
          call netwerk_end()
          stop
         end if
c        lees client
c         lengte = netwerk_read_line(client,buffer)
         buffer=cmdbuf
         lengte = length(buffer)
         write(6,*)client,lengte,'->',buffer(1:length(buffer)-1)
c        eerste regel bevat de opdracht GET/POST /<request> HTTP/1.1
         i=instr(buffer,'GET')
         if (i.gt.0) then
            cmd=GET
         else
            i=instr(buffer,'POST')
            if (i.gt.0) then
            cmd=POST
            else
            cmd=UNKNOW
            end if
         endif
         j=instr(buffer,' HTTP')
         if (j.eq.0) cmd=UNKNOW
c        init commando
         cmdbuf=' '
         contenttype=WWW
         contentlength=0
         i=instr(buffer(1:lengte),'/')
         if(cmd.ne.UNKNOW)cmdbuf=buffer(i+1:j)
         call replace_all(cmdbuf,'+',' ')
         call replace_all(cmdbuf,'&','\n')
         call convert_ascii(cmdbuf)
         do while (lengte.gt.1)
            lengte = netwerk_read_line(client,buffer)
            if(cmd.eq.POST)then
c             zoek naar Content-type: ... plain of data of -www-form
              buffer=ucase(buffer(1:lengte))
              i=instr(buffer(1:lengte),'CONTENT-TYPE')
              if (i.gt.0) then
                i=instr(buffer(1:lengte),'PLAIN')
                if (i.gt.0) then
                   contenttype=PLAIN
                else
                   i=instr(buffer(1:lengte),'DATA')
                   if(i.gt.0)contenttype=DATA 
                end if
              else
c             zoek naar Content-Length: aantal bytes 
                i=instr(buffer(1:lengte),'CONTENT-LENGTH')
                if (i.gt.0)then
                  i=instr(buffer(1:lengte),':')
                  contentlength=val(buffer(i+1:lengte-1))
                end if
              end if
            end if
         end do
c        write(6,*)'CMDBUF=',cmdbuf(1:length(cmdbuf)),' CMD=',cmd,
c    x   ' LENGTH=',contentlength,
c    x   ' TYPE=',contenttype
c
c        indien POST dan volgt nu de text van de client
c
         if (CMD.eq.POST)then
c           schrijf dit naar post.cmd
            open(1,file='post.cmd',form='formatted')
            if    (contenttype.eq.PLAIN)then
            do while(contentlength.gt.0)
               lengte = netwerk_read_line(client,buffer)
               contentlength=contentlength-lengte-1
               write(1,'(a,$)')buffer(1:lengte)
               write(6,'(a,$)')buffer(1:lengte)
            end do
            elseif(contenttype.eq.DATA )then
            else
c                                 WWW
            buffer=' '
            lengte=0
            do while(contentlength.gt.0)
               i = netwerk_read_char(client)
               if (i.gt.0) then
                  contentlength=contentlength-1
                  lengte=lengte+1
                  buffer(lengte:lengte)=char(i)
               else
                  contentlength=0
               endif
            end do
            call replace_all(buffer,'+',' ')
            call replace_all(buffer,'&','\n')
            call convert_ascii(buffer)
            write(1,'(a,$)')buffer(1:lengte)
            write(6,'(a,$)')buffer(1:lengte)
            end if
            close(1)
         end if
      return

      entry responseclient(filename)
      fileunit=4
      open(fileunit,file=filename(1:length(filename)),
     x     form='formatted',status='old',err=90)
      read(fileunit,'(a)')buffer
      call response_HTTP(client,buffer)
      i=netwerk_puts(client,buffer(1:length(buffer)))
      do while(1.eq.1)
         read(fileunit,'(a)',end=10)buffer
         i=netwerk_puts(client,buffer(1:length(buffer)))
         i=netwerk_puts(client,'\n')
      end do
10    close(fileunit)
      call netwerk_close(client)
      return
90    call response_HTTP(client,' ')
      i=netwerk_puts(client,'File not found , sorry')
      call netwerk_close(client)
      write(6,*)'file: ',cmdbuf(1:length(cmdbuf)),' not found'
      return
c
      entry responsetext(filename)
      call response_HTTP(client,' ')
      i=netwerk_puts(client,filename)
      call netwerk_close(client)
      return
c
      entry write_open_client(filename)
      call response_HTTP(client,filename)
c      write(6,*)filename(1:length(filename))
      i=netwerk_puts(client,filename(1:length(filename)))
      return
      entry write_client_buf()
c      write(6,*)cmdbuf(1:length(cmdbuf))
      i=netwerk_puts(client,cmdbuf(1:length(cmdbuf)))
      return
      entry write_client(filename)
c      write(6,*)filename(1:length(filename))
      i=netwerk_puts(client,filename(1:length(filename)))
      return
      entry write_close_client()
      i=netwerk_puts(client,'</body></html>')
      call netwerk_close(client)
      return

      entry no_response()
      call response_HTTP_noop(client)
      call netwerk_close(client)
      return

      entry quitserver
      call quit_window("Quit","silver")
c      call response_HTTP(client,' ')
c      i=netwerk_puts(client,'Einde oefening , server closed !')
c      call netwerk_close(client)
      call netwerk_close(server)
      call netwerk_end()
      end 
c ------------------------------------------------------------
      integer function netwerk_read_char(client)
      implicit integer*2(a-z)
      integer client
      character inchar*2
      i=0
      do while(i.eq.0)
         i = netwerk_read(client,inchar,len(inchar),1)
      end do
      if(i.gt.0)then
      netwerk_read_char=ichar(inchar(1:1))
      else
      netwerk_read_char=i
      endif
      end
c ------------------------------------------------------------
      integer function netwerk_read_line(client,line)
      implicit integer*2(a-z)
      integer client
      character line*(*),cr*1,lf*1,inchar*2
      integer   linelength
      integer   index,i
      data cr/'\r'/,lf/'\n'/

      index=0
      linelength = len(line)
      inchar=''
      line=' '
      i=0
c     get char
      do while((i.ge.0).and.(inchar(1:1).ne.lf).and.
     1         (index.lt.linelength))
         i = netwerk_read(client,inchar,len(inchar),1)
         if(i.gt.0)then
           if(inchar(1:1).ne.cr)then
             index=index+1
             line(index:index)=inchar(1:1)
           end if
         end if
      end do
      if (i.lt.0) then
         netwerk_read_line = i
      else
         netwerk_read_line = index
      end if
      return
      end
c --------------------------------------------------------
      integer function init_server()
      implicit integer*2(a-z)
      integer server , serverpoort
      character mode*1
      character serveradres*14 
c     data mode/'s'/
      data serveradres/'127.0.0.1:'/
      serverpoort = 4990
      server = 0
      i = netwerk_init()
      if(i.lt.0)then
        write(6,*)'error cann''t init'
        stop
      end if
c ander onbegrepen idee wie blokkeert de poortnummers 5001 en hoger  ?
c dit start meerdere servers met zelfde poort adres
c vreemd ik dacht een server socket met poort adres als fout werd beschouwd
      do while((server.ge.0).and.(serverpoort.le.5001))
       serverpoort=serverpoort+1
       write(serveradres(11:14),'(I4,$)')serverpoort
       write(6,*)serveradres
       mode='c'
       server=netwerk_open(serveradres,mode)
c      indien gevonden geeft dit fouten aan de server site daar er geen
c      n.l. een EOF 
       if(server.ge.0)call netwerk_close(server)
      end do
      mode='s'
      server=netwerk_open(serveradres,mode)
      if(server.lt.0)then
        write(6,*)'error cann''t open server'
        stop
      end if
      call system('defaultbrowser http://'//serveradres)
      init_server=server
      end
c --------------------------------------------------------
      integer function get_connect(server)
      implicit integer*2(a-z)
      integer server,client,cmd,timeout,time
      integer lengte,netwerk_read_line
      character *512 cmdbuf
      common /serverdata/cmd,cmdbuf
      character mode*1
      data mode/'a'/
      do while(.true.)
       client=0
       timeout=time()+75
       do while(client.eq.0)
        client=netwerk_open(server,mode)
        if (timeout<time())then
c         time-out error : close server and dump program
          call netwerk_close(server)
          call netwerk_end()
          write(6,*)'Progam abort due Time-Out at ',time()
          stop
        end if
       end do
       if (client.gt.0)then
        lengte = netwerk_read_line(client,cmdbuf)
        if (lengte.lt.0)then
c        error client closed (search port number)
         call netwerk_close(client)
        else if (instr(cmdbuf,'tick').gt.0) then
         call response_HTTP_noop(client)
         call netwerk_close(client)
        else
         exit
        end if
       else if (client.lt.0)then
c        error cann't accept
         exit
       end if
      end do
      get_connect=client
      end
c --------------------------------------------------------
      subroutine remove_all(buffer,teken)
      implicit integer*2(a-z)
      character buffer*(*),teken*1
      i=instr(buffer,teken)
      do while (i.gt.0)
         j=length(buffer)
         if (i.eq.1) then
            buffer=buffer(2:j)
         else if (i.eq.j) then
            buffer=buffer(1:j-1)
         else
            buffer=buffer(1:i-1)//buffer(i+1:j)
         end if
         i=instr(buffer,teken)
      end do
      end
c --------------------------------------------------------
      subroutine replace_all(buffer,teken,met)
      implicit integer*2(a-z)
      character buffer*(*),teken*1,met*1
      i=instr(buffer,teken)
      do while (i.gt.0)
         buffer(i:i)=met
         i=instr(buffer,teken)
      end do
      end
c --------------------------------------------------------
      subroutine convert_ascii(buffer)
      implicit integer*2(a-z)
      character buffer*(*),hexval*2,teken*1
      i=instr(buffer,'%')
      do while (i.gt.0)
         hexval=buffer(i+1:i+2)
         teken =char(val_hex(hexval))
         buffer(i:i)=teken
         buffer(i+1:)=buffer(i+3:length(buffer))
         i=instr(buffer,'%')
      end do
      end
c --------------------------------------------------------
      subroutine response_HTTP(client,text)
      implicit integer*2(a-z)
      integer client,time
      character text*(*),ucase*512
      i=netwerk_puts(client,'HTTP/1.1 200 OK\r\n')
      i=netwerk_puts(client,'Cache-Control:no-cache\r\n')
c      i=netwerk_puts(client,'Connection: close\r\n')
      if (length(text).eq.0)then
        klad=0
      else
        klad=instr(ucase(text),'<HTML>')
      end if
      if (klad.ne.0) then
        i=netwerk_puts(client,'Content-Type: text/html\r\n')
      else
        i=netwerk_puts(client,'Content-Type: text/plain\r\n')
      end if
      i=netwerk_puts(client,'\r\n')
      return

      ENTRY response_HTTP_noop(client)
      write(6,*)'No-op = HTTP/1.1 204 OK'
c      write(6,*)time()
      i=netwerk_puts(client,'HTTP/1.1 204 OK\r\n')
      i=netwerk_puts(client,'\r\n')
      return
      end
c ----------------------------------------------------------
      subroutine command_from_client()
      implicit integer*2(a-z)
      parameter (UNKNOW=0,GET=1,POST=2)
      character *512 cmdbuf
      integer   cmd
      common /serverdata/cmd,cmdbuf
1234  call requestclient
      write(6,*)
     x'command_from_client CMDBUF=',cmdbuf(1:length(cmdbuf)),' CMD=',cmd
c     dit omdat er mogelijk css e.d files gevraagd worden
      if (cmd.eq.GET) then
c      mogelijk moet hier een selektie gemaakt worden welke
c      file types wel en niet worden beschouwd als antwoord
c      b.v. xx.exe zou als commando moeten worden beschouwd.
c      even zo geldt dat niet iedere string waar een punt invoorkomt
c      ook een file is .
       if (instr(cmdbuf,'.').gt.0) then
         CALL responseclient(cmdbuf)
         goto 1234
       endif
      endif
      end