* Debug capture separated out

packages/fcl-web/examples/debugcapture/.gitignore

@@ -0,0 +1,2 @@
+lib
+demosvr

packages/fcl-web/examples/debugcapture/README.txt

@@ -0,0 +1,44 @@
+
+Small demo for simple file module. The server will listen on a specified
+port (default 3000) and will serve files starting from the current working
+directory.
+
+Just start the server, no options, and point your browser at
+http://localhost:3000/
+
+running simpleserver -h will provide the following help:
+
+-d --directory=dir  
+
+  Base directory from which to serve files.
+  Default is current working directory: /home/michael/FPC/trunk/packages/fcl-web/examples/simpleserver
+
+-i --indexpage=name 
+
+  Directory index page to use (default: index.html)
+
+-n --noindexpage    
+
+  Do not allow index page.
+
+-p --port=NNNN      
+
+  TCP/IP port to listen on (default is 3000)
+
+-m --mimetypes=file 
+
+  path of mime.types file. Loaded in addition to OS known types.
+
+  A sample mime.types file is provided.
+
+-q --quiet          
+
+  Do not write diagnostic messages
+
+-s --ssl            
+
+  Use SSL. 
+  If you set this, the -H or --hostname option must also be used.
+
+-H --hostname=NAME  
+  set hostname for self-signed SSL certificate

packages/fcl-web/examples/debugcapture/demosvr.pas

@@ -0,0 +1,80 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    Sample HTTP server application
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$h+}
+
+program demosvr;
+
+uses
+  custhttpapp,  sysutils, Classes, jsonparser, fpjson, httproute, httpdefs, fpmimetypes, fpwebfile, fpwebproxy,
+  fpdebugcapturesvc;
+
+Type
+  { THTTPApplication }
+
+  THTTPApplication = Class(TCustomHTTPApplication)
+  private
+    procedure HandleCaptureOutput(aSender: TObject; aCapture: TJSONData);
+  published
+    procedure DoLog(EventType: TEventType; const Msg: String); override;
+    Procedure Initialize; override;
+  end;
+
+procedure THTTPApplication.DoLog(EventType: TEventType; const Msg: String);
+begin
+  if IsConsole then
+    Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',Now),' [',EventType,'] ',Msg)
+  else
+    inherited DoLog(EventType, Msg);
+end;
+
+procedure THTTPApplication.Initialize;
+
+var
+  aBaseDir : String;
+  Svc : TDebugCaptureService;
+
+begin
+  Port:=8080;
+  Svc:=TDebugCaptureService.Instance;
+  Svc.OnLog:=@DoLog;
+  Svc.LogFileName:='debug.log';
+  Svc.RegisterHandler('log',@HandleCaptureOutput);
+  HTTPRouter.RegisterRoute('/debugcapture',rmPost,@Svc.HandleRequest,False);
+  aBaseDir:=IncludeTrailingPathDelimiter(GetCurrentDir);
+  TSimpleFileModule.RegisterDefaultRoute;
+  TSimpleFileModule.BaseDir:=aBaseDir;
+  TSimpleFileModule.OnLog:=@Log;
+  TSimpleFileModule.IndexPageName:='index.html';
+  MimeTypes.LoadKnownTypes;
+  inherited;
+end;
+
+procedure THTTPApplication.HandleCaptureOutput(aSender: TObject; aCapture: TJSONData);
+begin
+  DoLog(etDebug,TDebugCaptureService.JSONDataToString(aCapture));
+end;
+
+
+Var
+  Application : THTTPApplication;
+
+begin
+  Application:=THTTPApplication.Create(Nil);
+  Application.Initialize;
+  Application.Run;
+  Application.Free;
+end.
+

packages/fcl-web/examples/debugcapture/mime.types

@@ -0,0 +1,836 @@
+###############################################################################
+#
+#  MIME media types and the extensions that represent them.
+#
+#  The format of this file is a media type on the left and zero or more
+#  filename extensions on the right.  Programs using this file will map
+#  files ending with those extensions to the associated type.
+#
+#  This file is part of the "mime-support" package.  Please report a bug using
+#  the "reportbug" command of the "reportbug" package if you would like new
+#  types or extensions to be added.
+#
+#  The reason that all types are managed by the mime-support package instead
+#  allowing individual packages to install types in much the same way as they
+#  add entries in to the mailcap file is so these types can be referenced by
+#  other programs (such as a web server) even if the specific support package
+#  for that type is not installed.
+#
+#  Users can add their own types if they wish by creating a ".mime.types"
+#  file in their home directory.  Definitions included there will take
+#  precedence over those listed here.
+#
+###############################################################################
+
+
+application/activemessage
+application/andrew-inset			ez
+application/annodex				anx
+application/applefile
+application/atom+xml				atom
+application/atomcat+xml				atomcat
+application/atomicmail
+application/atomserv+xml			atomsrv
+application/batch-SMTP
+application/bbolin				lin
+application/beep+xml
+application/cals-1840
+application/commonground
+application/cu-seeme				cu
+application/cybercash
+application/davmount+xml			davmount
+application/dca-rft
+application/dec-dx
+application/dicom				dcm
+application/docbook+xml
+application/dsptype				tsp
+application/dvcs
+application/ecmascript				es
+application/edi-consent
+application/edi-x12
+application/edifact
+application/eshop
+application/font-sfnt				otf ttf
+application/font-tdpfr				pfr
+application/font-woff				woff
+application/futuresplash			spl
+application/ghostview
+application/gzip				gz
+application/hta					hta
+application/http
+application/hyperstudio
+application/iges
+application/index
+application/index.cmd
+application/index.obj
+application/index.response
+application/index.vnd
+application/iotp
+application/ipp
+application/isup
+application/java-archive			jar
+application/java-serialized-object		ser
+application/java-vm				class
+application/javascript				js
+application/json				json
+application/m3g					m3g
+application/mac-binhex40			hqx
+application/mac-compactpro			cpt
+application/macwriteii
+application/marc
+application/mathematica				nb nbp
+application/mbox				mbox
+application/ms-tnef
+application/msaccess				mdb
+application/msword				doc dot
+application/mxf					mxf
+application/news-message-id
+application/news-transmission
+application/ocsp-request
+application/ocsp-response
+application/octet-stream			bin deploy msu msp
+application/oda					oda
+application/oebps-package+xml			opf
+application/ogg					ogx
+application/onenote				one onetoc2 onetmp onepkg
+application/parityfec
+application/pdf					pdf
+application/pgp-encrypted			pgp
+application/pgp-keys				key
+application/pgp-signature			sig
+application/pics-rules				prf
+application/pkcs10
+application/pkcs7-mime
+application/pkcs7-signature
+application/pkix-cert
+application/pkix-crl
+application/pkixcmp
+application/postscript				ps ai eps epsi epsf eps2 eps3
+application/prs.alvestrand.titrax-sheet
+application/prs.cww
+application/prs.nprend
+application/qsig
+application/rar					rar
+application/rdf+xml				rdf
+application/remote-printing
+application/riscos
+application/rtf					rtf
+application/sdp
+application/set-payment
+application/set-payment-initiation
+application/set-registration
+application/set-registration-initiation
+application/sgml
+application/sgml-open-catalog
+application/sieve
+application/sla					stl
+application/slate
+application/smil+xml				smi smil
+application/timestamp-query
+application/timestamp-reply
+application/vemmi
+application/whoispp-query
+application/whoispp-response
+application/wita
+application/x400-bp
+application/xhtml+xml				xhtml xht
+application/xml					xml xsd
+application/xml-dtd
+application/xml-external-parsed-entity
+application/xslt+xml				xsl xslt
+application/xspf+xml				xspf
+application/zip					zip
+application/vnd.3M.Post-it-Notes
+application/vnd.accpac.simply.aso
+application/vnd.accpac.simply.imp
+application/vnd.acucobol
+application/vnd.aether.imp
+application/vnd.android.package-archive						apk
+application/vnd.anser-web-certificate-issue-initiation
+application/vnd.anser-web-funds-transfer-initiation
+application/vnd.audiograph
+application/vnd.bmi
+application/vnd.businessobjects
+application/vnd.canon-cpdl
+application/vnd.canon-lips
+application/vnd.cinderella							cdy
+application/vnd.claymore
+application/vnd.commerce-battelle
+application/vnd.commonspace
+application/vnd.comsocaller
+application/vnd.contact.cmsg
+application/vnd.cosmocaller
+application/vnd.ctc-posml
+application/vnd.cups-postscript
+application/vnd.cups-raster
+application/vnd.cups-raw
+application/vnd.cybank
+application/vnd.debian.binary-package						deb ddeb udeb
+application/vnd.dna
+application/vnd.dpgraph
+application/vnd.dxr
+application/vnd.ecdis-update
+application/vnd.ecowin.chart
+application/vnd.ecowin.filerequest
+application/vnd.ecowin.fileupdate
+application/vnd.ecowin.series
+application/vnd.ecowin.seriesrequest
+application/vnd.ecowin.seriesupdate
+application/vnd.enliven
+application/vnd.epson.esf
+application/vnd.epson.msf
+application/vnd.epson.quickanime
+application/vnd.epson.salt
+application/vnd.epson.ssf
+application/vnd.ericsson.quickcall
+application/vnd.eudora.data
+application/vnd.fdf
+application/vnd.ffsns
+application/vnd.flographit
+application/vnd.font-fontforge-sfd						sfd
+application/vnd.framemaker
+application/vnd.fsc.weblaunch
+application/vnd.fujitsu.oasys
+application/vnd.fujitsu.oasys2
+application/vnd.fujitsu.oasys3
+application/vnd.fujitsu.oasysgp
+application/vnd.fujitsu.oasysprs
+application/vnd.fujixerox.ddd
+application/vnd.fujixerox.docuworks
+application/vnd.fujixerox.docuworks.binder
+application/vnd.fut-misnet
+application/vnd.google-earth.kml+xml						kml
+application/vnd.google-earth.kmz						kmz
+application/vnd.grafeq
+application/vnd.groove-account
+application/vnd.groove-identity-message
+application/vnd.groove-injector
+application/vnd.groove-tool-message
+application/vnd.groove-tool-template
+application/vnd.groove-vcard
+application/vnd.hhe.lesson-player
+application/vnd.hp-HPGL
+application/vnd.hp-PCL
+application/vnd.hp-PCLXL
+application/vnd.hp-hpid
+application/vnd.hp-hps
+application/vnd.httphone
+application/vnd.hzn-3d-crossword
+application/vnd.ibm.MiniPay
+application/vnd.ibm.afplinedata
+application/vnd.ibm.modcap
+application/vnd.informix-visionary
+application/vnd.intercon.formnet
+application/vnd.intertrust.digibox
+application/vnd.intertrust.nncp
+application/vnd.intu.qbo
+application/vnd.intu.qfx
+application/vnd.irepository.package+xml
+application/vnd.is-xpr
+application/vnd.japannet-directory-service
+application/vnd.japannet-jpnstore-wakeup
+application/vnd.japannet-payment-wakeup
+application/vnd.japannet-registration
+application/vnd.japannet-registration-wakeup
+application/vnd.japannet-setstore-wakeup
+application/vnd.japannet-verification
+application/vnd.japannet-verification-wakeup
+application/vnd.koan
+application/vnd.lotus-1-2-3
+application/vnd.lotus-approach
+application/vnd.lotus-freelance
+application/vnd.lotus-notes
+application/vnd.lotus-organizer
+application/vnd.lotus-screencam
+application/vnd.lotus-wordpro
+application/vnd.mcd
+application/vnd.mediastation.cdkey
+application/vnd.meridian-slingshot
+application/vnd.mif
+application/vnd.minisoft-hp3000-save
+application/vnd.mitsubishi.misty-guard.trustweb
+application/vnd.mobius.daf
+application/vnd.mobius.dis
+application/vnd.mobius.msl
+application/vnd.mobius.plc
+application/vnd.mobius.txf
+application/vnd.motorola.flexsuite
+application/vnd.motorola.flexsuite.adsi
+application/vnd.motorola.flexsuite.fis
+application/vnd.motorola.flexsuite.gotap
+application/vnd.motorola.flexsuite.kmr
+application/vnd.motorola.flexsuite.ttc
+application/vnd.motorola.flexsuite.wem
+application/vnd.mozilla.xul+xml							xul
+application/vnd.ms-artgalry
+application/vnd.ms-asf
+application/vnd.ms-excel							xls xlb xlt
+application/vnd.ms-excel.addin.macroEnabled.12					xlam
+application/vnd.ms-excel.sheet.binary.macroEnabled.12				xlsb
+application/vnd.ms-excel.sheet.macroEnabled.12					xlsm
+application/vnd.ms-excel.template.macroEnabled.12				xltm
+application/vnd.ms-fontobject							eot
+application/vnd.ms-lrm
+application/vnd.ms-officetheme							thmx
+application/vnd.ms-pki.seccat							cat
+#application/vnd.ms-pki.stl							stl
+application/vnd.ms-powerpoint							ppt pps
+application/vnd.ms-powerpoint.addin.macroEnabled.12				ppam
+application/vnd.ms-powerpoint.presentation.macroEnabled.12			pptm
+application/vnd.ms-powerpoint.slide.macroEnabled.12				sldm
+application/vnd.ms-powerpoint.slideshow.macroEnabled.12				ppsm
+application/vnd.ms-powerpoint.template.macroEnabled.12				potm
+application/vnd.ms-project
+application/vnd.ms-tnef
+application/vnd.ms-word.document.macroEnabled.12				docm
+application/vnd.ms-word.template.macroEnabled.12				dotm
+application/vnd.ms-works
+application/vnd.mseq
+application/vnd.msign
+application/vnd.music-niff
+application/vnd.musician
+application/vnd.netfpx
+application/vnd.noblenet-directory
+application/vnd.noblenet-sealer
+application/vnd.noblenet-web
+application/vnd.novadigm.EDM
+application/vnd.novadigm.EDX
+application/vnd.novadigm.EXT
+application/vnd.oasis.opendocument.chart					odc
+application/vnd.oasis.opendocument.database					odb
+application/vnd.oasis.opendocument.formula					odf
+application/vnd.oasis.opendocument.graphics					odg
+application/vnd.oasis.opendocument.graphics-template				otg
+application/vnd.oasis.opendocument.image					odi
+application/vnd.oasis.opendocument.presentation					odp
+application/vnd.oasis.opendocument.presentation-template			otp
+application/vnd.oasis.opendocument.spreadsheet					ods
+application/vnd.oasis.opendocument.spreadsheet-template				ots
+application/vnd.oasis.opendocument.text						odt
+application/vnd.oasis.opendocument.text-master					odm
+application/vnd.oasis.opendocument.text-template				ott
+application/vnd.oasis.opendocument.text-web					oth
+application/vnd.openxmlformats-officedocument.presentationml.presentation	pptx
+application/vnd.openxmlformats-officedocument.presentationml.slide		sldx
+application/vnd.openxmlformats-officedocument.presentationml.slideshow		ppsx
+application/vnd.openxmlformats-officedocument.presentationml.template		potx
+application/vnd.openxmlformats-officedocument.spreadsheetml.sheet		xlsx
+application/vnd.openxmlformats-officedocument.spreadsheetml.template		xltx
+application/vnd.openxmlformats-officedocument.wordprocessingml.document		docx
+application/vnd.openxmlformats-officedocument.wordprocessingml.template		dotx
+application/vnd.osa.netdeploy
+application/vnd.palm
+application/vnd.pg.format
+application/vnd.pg.osasli
+application/vnd.powerbuilder6
+application/vnd.powerbuilder6-s
+application/vnd.powerbuilder7
+application/vnd.powerbuilder7-s
+application/vnd.powerbuilder75
+application/vnd.powerbuilder75-s
+application/vnd.previewsystems.box
+application/vnd.publishare-delta-tree
+application/vnd.pvi.ptid1
+application/vnd.pwg-xhtml-print+xml
+application/vnd.rapid
+application/vnd.rim.cod								cod
+application/vnd.s3sms
+application/vnd.seemail
+application/vnd.shana.informed.formdata
+application/vnd.shana.informed.formtemplate
+application/vnd.shana.informed.interchange
+application/vnd.shana.informed.package
+application/vnd.smaf								mmf
+application/vnd.sss-cod
+application/vnd.sss-dtf
+application/vnd.sss-ntf
+application/vnd.stardivision.calc						sdc
+application/vnd.stardivision.chart						sds
+application/vnd.stardivision.draw						sda
+application/vnd.stardivision.impress						sdd
+application/vnd.stardivision.math						sdf
+application/vnd.stardivision.writer						sdw
+application/vnd.stardivision.writer-global					sgl
+application/vnd.street-stream
+application/vnd.sun.xml.calc							sxc
+application/vnd.sun.xml.calc.template						stc
+application/vnd.sun.xml.draw							sxd
+application/vnd.sun.xml.draw.template						std
+application/vnd.sun.xml.impress							sxi
+application/vnd.sun.xml.impress.template					sti
+application/vnd.sun.xml.math							sxm
+application/vnd.sun.xml.writer							sxw
+application/vnd.sun.xml.writer.global						sxg
+application/vnd.sun.xml.writer.template						stw
+application/vnd.svd
+application/vnd.swiftview-ics
+application/vnd.symbian.install							sis
+application/vnd.tcpdump.pcap							cap pcap
+application/vnd.triscape.mxs
+application/vnd.trueapp
+application/vnd.truedoc
+application/vnd.tve-trigger
+application/vnd.ufdl
+application/vnd.uplanet.alert
+application/vnd.uplanet.alert-wbxml
+application/vnd.uplanet.bearer-choice
+application/vnd.uplanet.bearer-choice-wbxml
+application/vnd.uplanet.cacheop
+application/vnd.uplanet.cacheop-wbxml
+application/vnd.uplanet.channel
+application/vnd.uplanet.channel-wbxml
+application/vnd.uplanet.list
+application/vnd.uplanet.list-wbxml
+application/vnd.uplanet.listcmd
+application/vnd.uplanet.listcmd-wbxml
+application/vnd.uplanet.signal
+application/vnd.vcx
+application/vnd.vectorworks
+application/vnd.vidsoft.vidconference
+application/vnd.visio								vsd vst vsw vss
+application/vnd.vividence.scriptfile
+application/vnd.wap.sic
+application/vnd.wap.slc
+application/vnd.wap.wbxml							wbxml
+application/vnd.wap.wmlc							wmlc
+application/vnd.wap.wmlscriptc							wmlsc
+application/vnd.webturbo
+application/vnd.wordperfect							wpd
+application/vnd.wordperfect5.1							wp5
+application/vnd.wrq-hp3000-labelled
+application/vnd.wt.stf
+application/vnd.xara
+application/vnd.xfdl
+application/vnd.yellowriver-custom-menu
+application/zlib
+application/x-123				wk
+application/x-7z-compressed			7z
+application/x-abiword				abw
+application/x-apple-diskimage			dmg
+application/x-bcpio				bcpio
+application/x-bittorrent			torrent
+application/x-cab				cab
+application/x-cbr				cbr
+application/x-cbz				cbz
+application/x-cdf				cdf cda
+application/x-cdlink				vcd
+application/x-chess-pgn				pgn
+application/x-comsol				mph
+application/x-core
+application/x-cpio				cpio
+application/x-csh				csh
+application/x-debian-package			deb udeb
+application/x-director				dcr dir dxr
+application/x-dms				dms
+application/x-doom				wad
+application/x-dvi				dvi
+application/x-executable
+application/x-font				pfa pfb gsf
+application/x-font-pcf				pcf pcf.Z
+application/x-freemind				mm
+application/x-futuresplash			spl
+application/x-ganttproject			gan
+application/x-gnumeric				gnumeric
+application/x-go-sgf				sgf
+application/x-graphing-calculator		gcf
+application/x-gtar				gtar
+application/x-gtar-compressed			tgz taz
+application/x-hdf				hdf
+#application/x-httpd-eruby			rhtml
+#application/x-httpd-php			phtml pht php
+#application/x-httpd-php-source			phps
+#application/x-httpd-php3			php3
+#application/x-httpd-php3-preprocessed		php3p
+#application/x-httpd-php4			php4
+#application/x-httpd-php5			php5
+application/x-hwp				hwp
+application/x-ica				ica
+application/x-info				info
+application/x-internet-signup			ins isp
+application/x-iphone				iii
+application/x-iso9660-image			iso
+application/x-jam				jam
+application/x-java-applet
+application/x-java-bean
+application/x-java-jnlp-file			jnlp
+application/x-jmol				jmz
+application/x-kchart				chrt
+application/x-kdelnk
+application/x-killustrator			kil
+application/x-koan				skp skd skt skm
+application/x-kpresenter			kpr kpt
+application/x-kspread				ksp
+application/x-kword				kwd kwt
+application/x-latex				latex
+application/x-lha				lha
+application/x-lyx				lyx
+application/x-lzh				lzh
+application/x-lzx				lzx
+application/x-maker				frm maker frame fm fb book fbdoc
+application/x-mif				mif
+application/x-mpegURL				m3u8
+application/x-ms-application			application
+application/x-ms-manifest			manifest
+application/x-ms-wmd				wmd
+application/x-ms-wmz				wmz
+application/x-msdos-program			com exe bat dll
+application/x-msi				msi
+application/x-netcdf				nc
+application/x-ns-proxy-autoconfig		pac
+application/x-nwc				nwc
+application/x-object				o
+application/x-oz-application			oza
+application/x-pkcs7-certreqresp			p7r
+application/x-pkcs7-crl				crl
+application/x-python-code			pyc pyo
+application/x-qgis				qgs shp shx
+application/x-quicktimeplayer			qtl
+application/x-rdp				rdp
+application/x-redhat-package-manager		rpm
+application/x-rss+xml				rss
+application/x-ruby				rb
+application/x-rx
+application/x-scilab				sci sce
+application/x-scilab-xcos			xcos
+application/x-sh				sh
+application/x-shar				shar
+application/x-shellscript
+application/x-shockwave-flash			swf swfl
+application/x-silverlight			scr
+application/x-sql				sql
+application/x-stuffit				sit sitx
+application/x-sv4cpio				sv4cpio
+application/x-sv4crc				sv4crc
+application/x-tar				tar
+application/x-tcl				tcl
+application/x-tex-gf				gf
+application/x-tex-pk				pk
+application/x-texinfo				texinfo texi
+application/x-trash				~ % bak old sik
+application/x-troff				t tr roff
+application/x-troff-man				man
+application/x-troff-me				me
+application/x-troff-ms				ms
+application/x-ustar				ustar
+application/x-videolan
+application/x-wais-source			src
+application/x-wingz				wz
+application/x-x509-ca-cert			crt
+application/x-xcf				xcf
+application/x-xfig				fig
+application/x-xpinstall				xpi
+application/x-xz				xz
+
+audio/32kadpcm
+audio/3gpp
+audio/amr					amr
+audio/amr-wb					awb
+audio/annodex					axa
+audio/basic					au snd
+audio/csound					csd orc sco
+audio/flac					flac
+audio/g.722.1
+audio/l16
+audio/midi					mid midi kar
+audio/mp4a-latm
+audio/mpa-robust
+audio/mpeg					mpga mpega mp2 mp3 m4a
+audio/mpegurl					m3u
+audio/ogg					oga ogg opus spx
+audio/parityfec
+audio/prs.sid					sid
+audio/telephone-event
+audio/tone
+audio/vnd.cisco.nse
+audio/vnd.cns.anp1
+audio/vnd.cns.inf1
+audio/vnd.digital-winds
+audio/vnd.everad.plj
+audio/vnd.lucent.voice
+audio/vnd.nortel.vbk
+audio/vnd.nuera.ecelp4800
+audio/vnd.nuera.ecelp7470
+audio/vnd.nuera.ecelp9600
+audio/vnd.octel.sbc
+audio/vnd.qcelp
+audio/vnd.rhetorex.32kadpcm
+audio/vnd.vmx.cvsd
+audio/x-aiff					aif aiff aifc
+audio/x-gsm					gsm
+audio/x-mpegurl					m3u
+audio/x-ms-wma					wma
+audio/x-ms-wax					wax
+audio/x-pn-realaudio-plugin
+audio/x-pn-realaudio				ra rm ram
+audio/x-realaudio				ra
+audio/x-scpls					pls
+audio/x-sd2					sd2
+audio/x-wav					wav
+
+chemical/x-alchemy				alc
+chemical/x-cache				cac cache
+chemical/x-cache-csf				csf
+chemical/x-cactvs-binary			cbin cascii ctab
+chemical/x-cdx					cdx
+chemical/x-cerius				cer
+chemical/x-chem3d				c3d
+chemical/x-chemdraw				chm
+chemical/x-cif					cif
+chemical/x-cmdf					cmdf
+chemical/x-cml					cml
+chemical/x-compass				cpa
+chemical/x-crossfire				bsd
+chemical/x-csml					csml csm
+chemical/x-ctx					ctx
+chemical/x-cxf					cxf cef
+#chemical/x-daylight-smiles			smi
+chemical/x-embl-dl-nucleotide			emb embl
+chemical/x-galactic-spc				spc
+chemical/x-gamess-input				inp gam gamin
+chemical/x-gaussian-checkpoint			fch fchk
+chemical/x-gaussian-cube			cub
+chemical/x-gaussian-input			gau gjc gjf
+chemical/x-gaussian-log				gal
+chemical/x-gcg8-sequence			gcg
+chemical/x-genbank				gen
+chemical/x-hin					hin
+chemical/x-isostar				istr ist
+chemical/x-jcamp-dx				jdx dx
+chemical/x-kinemage				kin
+chemical/x-macmolecule				mcm
+chemical/x-macromodel-input			mmd mmod
+chemical/x-mdl-molfile				mol
+chemical/x-mdl-rdfile				rd
+chemical/x-mdl-rxnfile				rxn
+chemical/x-mdl-sdfile				sd sdf
+chemical/x-mdl-tgf				tgf
+#chemical/x-mif					mif
+chemical/x-mmcif				mcif
+chemical/x-mol2					mol2
+chemical/x-molconn-Z				b
+chemical/x-mopac-graph				gpt
+chemical/x-mopac-input				mop mopcrt mpc zmt
+chemical/x-mopac-out				moo
+chemical/x-mopac-vib				mvb
+chemical/x-ncbi-asn1				asn
+chemical/x-ncbi-asn1-ascii			prt ent
+chemical/x-ncbi-asn1-binary			val aso
+chemical/x-ncbi-asn1-spec			asn
+chemical/x-pdb					pdb ent
+chemical/x-rosdal				ros
+chemical/x-swissprot				sw
+chemical/x-vamas-iso14976			vms
+chemical/x-vmd					vmd
+chemical/x-xtel					xtel
+chemical/x-xyz					xyz
+
+image/cgm
+image/g3fax
+image/gif					gif
+image/ief					ief
+image/jp2					jp2 jpg2
+image/jpeg					jpeg jpg jpe
+image/jpm					jpm
+image/jpx					jpx jpf
+image/naplps
+image/pcx					pcx
+image/png					png
+image/prs.btif
+image/prs.pti
+image/svg+xml					svg svgz
+image/tiff					tiff tif
+image/vnd.cns.inf2
+image/vnd.djvu					djvu djv
+image/vnd.dwg
+image/vnd.dxf
+image/vnd.fastbidsheet
+image/vnd.fpx
+image/vnd.fst
+image/vnd.fujixerox.edmics-mmr
+image/vnd.fujixerox.edmics-rlc
+image/vnd.microsoft.icon			ico
+image/vnd.mix
+image/vnd.net-fpx
+image/vnd.svf
+image/vnd.wap.wbmp				wbmp
+image/vnd.xiff
+image/x-canon-cr2				cr2
+image/x-canon-crw				crw
+image/x-cmu-raster				ras
+image/x-coreldraw				cdr
+image/x-coreldrawpattern			pat
+image/x-coreldrawtemplate			cdt
+image/x-corelphotopaint				cpt
+image/x-epson-erf				erf
+image/x-icon
+image/x-jg					art
+image/x-jng					jng
+image/x-ms-bmp					bmp
+image/x-nikon-nef				nef
+image/x-olympus-orf				orf
+image/x-photoshop				psd
+image/x-portable-anymap				pnm
+image/x-portable-bitmap				pbm
+image/x-portable-graymap			pgm
+image/x-portable-pixmap				ppm
+image/x-rgb					rgb
+image/x-xbitmap					xbm
+image/x-xpixmap					xpm
+image/x-xwindowdump				xwd
+
+inode/chardevice
+inode/blockdevice
+inode/directory-locked
+inode/directory
+inode/fifo
+inode/socket
+
+message/delivery-status
+message/disposition-notification
+message/external-body
+message/http
+message/s-http
+message/news
+message/partial
+message/rfc822					eml
+
+model/iges					igs iges
+model/mesh					msh mesh silo
+model/vnd.dwf
+model/vnd.flatland.3dml
+model/vnd.gdl
+model/vnd.gs-gdl
+model/vnd.gtw
+model/vnd.mts
+model/vnd.vtu
+model/vrml					wrl vrml
+model/x3d+vrml					x3dv
+model/x3d+xml					x3d
+model/x3d+binary				x3db
+
+multipart/alternative
+multipart/appledouble
+multipart/byteranges
+multipart/digest
+multipart/encrypted
+multipart/form-data
+multipart/header-set
+multipart/mixed
+multipart/parallel
+multipart/related
+multipart/report
+multipart/signed
+multipart/voice-message
+
+text/cache-manifest				appcache
+text/calendar					ics icz
+text/css					css
+text/csv					csv
+text/directory
+text/english
+text/enriched
+text/h323					323
+text/html					html htm shtml
+text/iuls					uls
+text/mathml					mml
+text/markdown                                   md markdown
+text/parityfec
+text/plain					asc txt text pot brf srt
+text/prs.lines.tag
+text/rfc822-headers
+text/richtext					rtx
+text/rtf
+text/scriptlet					sct wsc
+text/t140
+text/texmacs					tm
+text/tab-separated-values			tsv
+text/turtle					ttl
+text/uri-list
+text/vcard					vcf vcard
+text/vnd.abc
+text/vnd.curl
+text/vnd.debian.copyright
+text/vnd.DMClientScript
+text/vnd.flatland.3dml
+text/vnd.fly
+text/vnd.fmi.flexstor
+text/vnd.in3d.3dml
+text/vnd.in3d.spot
+text/vnd.IPTC.NewsML
+text/vnd.IPTC.NITF
+text/vnd.latex-z
+text/vnd.motorola.reflex
+text/vnd.ms-mediapackage
+text/vnd.sun.j2me.app-descriptor		jad
+text/vnd.wap.si
+text/vnd.wap.sl
+text/vnd.wap.wml				wml
+text/vnd.wap.wmlscript				wmls
+text/x-bibtex					bib
+text/x-boo					boo
+text/x-c++hdr					h++ hpp hxx hh
+text/x-c++src					c++ cpp cxx cc
+text/x-chdr					h
+text/x-component				htc
+text/x-crontab
+text/x-csh					csh
+text/x-csrc					c
+text/x-dsrc					d
+text/x-diff					diff patch
+text/x-haskell					hs
+text/x-java					java
+text/x-lilypond					ly
+text/x-literate-haskell				lhs
+text/x-makefile
+text/x-moc					moc
+text/x-pascal					p pas
+text/x-pcs-gcd					gcd
+text/x-perl					pl pm
+text/x-python					py
+text/x-scala					scala
+text/x-server-parsed-html
+text/x-setext					etx
+text/x-sfv					sfv
+text/x-sh					sh
+text/x-tcl					tcl tk
+text/x-tex					tex ltx sty cls
+text/x-vcalendar				vcs
+
+video/3gpp					3gp
+video/annodex					axv
+video/dl					dl
+video/dv					dif dv
+video/fli					fli
+video/gl					gl
+video/mpeg					mpeg mpg mpe
+video/MP2T					ts
+video/mp4					mp4
+video/quicktime					qt mov
+video/mp4v-es
+video/ogg					ogv
+video/parityfec
+video/pointer
+video/webm					webm
+video/vnd.fvt
+video/vnd.motorola.video
+video/vnd.motorola.videop
+video/vnd.mpegurl				mxu
+video/vnd.mts
+video/vnd.nokia.interleaved-multimedia
+video/vnd.vivo
+video/x-flv					flv
+video/x-la-asf					lsf lsx
+video/x-mng					mng
+video/x-ms-asf					asf asx
+video/x-ms-wm					wm
+video/x-ms-wmv					wmv
+video/x-ms-wmx					wmx
+video/x-ms-wvx					wvx
+video/x-msvideo					avi
+video/x-sgi-movie				movie
+video/x-matroska				mpv mkv
+
+x-conference/x-cooltalk				ice
+
+x-epoc/x-sisx-app				sisx
+x-world/x-vrml					vrm vrml wrl

packages/fcl-web/examples/simpleserver/simpleserver.pas

@@ -42,7 +42,8 @@ uses
   {$ifdef unix}
   baseunix,
   {$endif}
-  sysutils,Classes, jsonparser, fpjson, strutils, inifiles, sslbase, httproute, httpdefs, fpmimetypes, fpwebfile, fpwebproxy, webutil;
+  sysutils, Classes, jsonparser, fpjson, strutils, inifiles, sslbase, httproute, httpdefs, fpmimetypes, fpwebfile, fpwebproxy,
+  webutil, fpdebugcapturesvc;
 
 Const
   ServerVersion = '1.0';
@@ -65,8 +66,6 @@ Type
 
   THTTPApplication = Class(TParentApp)
   private
-    FCaptureFileName : String;
-    FCaptureStream : TFileStream;
     FAPISecret : String;
     FBaseDir: string;
     FIndexPageName: String;
@@ -81,16 +80,12 @@ Type
     FCrossOriginIsolation : Boolean;
     procedure AddProxy(const aProxyDef: String);
     procedure DoEcho(ARequest: TRequest; AResponse: TResponse);
-    procedure DoCapture(ARequest: TRequest; AResponse: TResponse);
     procedure DoProxyLog(Sender: TObject; const aMethod, aLocation, aFromURL, aToURL: String);
     procedure DoQuit(ARequest: TRequest; AResponse: TResponse);
-    function GetCaptureJSON(ARequest: TRequest; AResponse: TResponse;
-      var aJSON: TJSONData): TJSONArray;
     procedure LoadMimeTypes;
     procedure ProcessOptions;
     procedure ReadConfigFile(const ConfigFile: string);
-    procedure SetupCapture(const aFileName: string);
-    procedure ShowCaptureOutput(aJSON: TJSONData);
+    procedure SetupCapture;
     procedure Usage(Msg: String);
     procedure Writeinfo;
   Public
@@ -145,81 +140,6 @@ begin
   end;
 end;
 
-function THTTPApplication.GetCaptureJSON(ARequest: TRequest;
-  AResponse: TResponse; var aJSON: TJSONData): TJSONArray;
-
-var
-  aJSONObj : TJSONObject absolute aJSON;
-  Cont : String;
-
-begin
-  Result:=Nil;
-  aJSON:=Nil;
-  try
-    Cont:=aRequest.Content;
-    aJSON:=GetJSON(Cont);
-    if aJSON.JSONType<>jtObject then
-      Raise EHTTP.Create('No JSON object in capture JSON');
-    Result:=aJSONObj.Get('lines',TJSONArray(Nil));
-    if Result=Nil then
-      begin
-      FreeAndNil(aJSON);
-      Raise EHTTP.Create('No lines element in capture JSON');
-      end;
-  except
-    On E : Exception do
-      begin
-      DoLog(etError,Format('Exception %s (%s) : Invalid capture content: not valid JSON: %s',[E.ClassName,E.Message,Copy(Cont,1,255)]));
-      aResponse.Code:=400;
-      aResponse.CodeText:='INVALID PARAM';
-      aResponse.SendResponse;
-      end;
-  end;
-end;
-
-procedure THTTPApplication.ShowCaptureOutput(aJSON : TJSONData);
-
-var
-  S : TJSONStringType;
-
-begin
-  if aJSON.JSONType in StructuredJSONTypes then
-    S:=aJSON.AsJSON
-  else
-    S:=aJSON.AsString;
-  if Assigned(FCaptureStream) then
-    begin
-    S:=S+sLineBreak;
-    FCaptureStream.WriteBuffer(S[1],Length(S)*SizeOf(TJSONCharType));
-    end
-  else
-    DoLog(etInfo,'Capture : '+S);
-end;
-
-procedure THTTPApplication.DoCapture(ARequest: TRequest; AResponse: TResponse);
-
-Var
-  aJSON : TJSONData;
-  aArray : TJSONArray;
-  I : Integer;
-
-begin
-  aJSON:=Nil;
-  aArray:=Nil;
-  try
-    aArray:=GetCaptureJSON(aRequest,aResponse,aJSON);
-    if aArray<>Nil then
-      begin
-      For I:=0 to aArray.Count-1 do
-        ShowCaptureOutput(aArray[i]);
-      aResponse.Code:=200;
-      aResponse.CodeText:='OK';
-      aResponse.SendResponse;
-      end;
-  finally
-    aJSON.Free;
-  end;
-end;
 
 procedure THTTPApplication.Doquit(ARequest: TRequest; AResponse: TResponse);
 
@@ -397,10 +317,8 @@ begin
       FCrossOriginIsolation:=ReadBool(SConfig,KeyCOI,FCrossOriginIsolation);
       if ValueExists(SConfig,KeyCapture) then
         begin
-        FCaptureFileName:=ReadString(SConfig,keyCapture,'');
-        if FCaptureFileName='' then
-          FCaptureFileName:='-';
-        end;  
+        TDebugCaptureService.Instance.LogFileName:=ReadString(SConfig,keyCapture,'');
+        end;
       L:=TstringList.Create;
       ReadSectionValues(SProxy,L,[]);
       For I:=0 to L.Count-1 do
@@ -465,9 +383,11 @@ begin
     FCrossOriginIsolation:=true;
   if HasOption('u','capture') then
     begin
-    FCaptureFileName:=GetOptionValue('u','capture');
-    if FCaptureFileName='' then
-      FCaptureFileName:='-';
+    S:=GetOptionValue('u','capture');
+    if S='' then
+      TDebugCaptureService.Instance.LogToConsole:=True
+    else
+      TDebugCaptureService.Instance.LogFileName:=S;
     end;
 end;
 
@@ -492,25 +412,25 @@ end;
 
 destructor THTTPApplication.Destroy;
 begin
-  FreeAndNil(FCaptureStream);
   inherited Destroy;
 end;
 
-procedure THTTPApplication.SetupCapture(Const aFileName : string);
+procedure THTTPApplication.SetupCapture;
 
 Var
- Dest : String;
+  Dest : String;
+  Svc : TDebugCaptureService;
 
 begin
-  if (aFileName<>'') and (aFileName<>'-') then
+  Svc:=TDebugCaptureService.Instance;
+  Dest:=Svc.LogFileName;
+  if (Dest='') and Svc.LogToConsole then
+    Dest:='Console';
+  if Dest<>'' then
     begin
-    FCaptureStream:=TFileStream.Create(aFileName,fmCreate);
-    Dest:='file: '+aFileName
-    end
-  else
-    Dest:='console';
-  DoLog(etInfo,Format('Setting up capture on route "%s", writing to %s',[SCaptureRoute,Dest]));
-  HTTPRouter.RegisterRoute(SCaptureRoute,rmPost,@DoCapture,False);
+    DoLog(etInfo,Format('Setting up capture on route "%s", writing to %s',[SCaptureRoute,Dest]));
+    HTTPRouter.RegisterRoute(SCaptureRoute,rmPost,@Svc.HandleRequest,False);
+    end;
 end;
 
 procedure THTTPApplication.DoRun;
@@ -543,8 +463,7 @@ begin
     Log(etError,'Background option not supported');
 {$endif}
     end;
-  if FCaptureFileName<>'' then
-    SetupCapture(FCaptureFileName);
+  SetupCapture;
   if FPassword<>'' then
     begin
     HTTPRouter.RegisterRoute('/quit',rmAll,@Doquit,False);

packages/fcl-web/fpmake.pp

@@ -253,6 +253,13 @@ begin
     // T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('fphttpapp.pp');
     T:=P.Targets.AddUnit('fpwebfile.pp');
+    With T.Dependencies do
+      begin
+      AddUnit('fphttp');
+      AddUnit('httpdefs');
+      AddUnit('httproute');
+      end;
+    T:=P.Targets.AddUnit('fpdebugcapturesvc.pp');
     With T.Dependencies do
       begin
       AddUnit('fphttp');

packages/fcl-web/src/base/fpdebugcapturesvc.pp

@@ -0,0 +1,365 @@
+unit fpdebugcapturesvc;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  CustApp, Classes, SysUtils, httpdefs, fphttp, fpjson;
+
+Type
+  TDebugCaptureHandler = Procedure (aSender : TObject; aCapture : TJSONData) of object;
+  TDebugCaptureLogHandler = Procedure (EventType : TEventType; const Msg : String) of object;
+
+  { THandlerRegistrationItem }
+
+  THandlerRegistrationItem = Class(TCollectionItem)
+  private
+    FHandler: TDebugCaptureHandler;
+    FName: String;
+  Public
+    Property Name : String Read FName Write FName;
+    Property Handler : TDebugCaptureHandler Read FHandler Write FHandler;
+  end;
+
+  { THandlerRegistrationList }
+
+  THandlerRegistrationList = class(TOwnedCollection)
+  private
+    function GetH(aIndex : Integer): THandlerRegistrationItem;
+    procedure SetH(aIndex : Integer; AValue: THandlerRegistrationItem);
+  Public
+    Function IndexOf(const aName : string) : Integer;
+    Function Find(const aName : string) : THandlerRegistrationItem;
+    Function Add(const aName : string; aHandler : TDebugCaptureHandler) : THandlerRegistrationItem;
+    Property Handlers[aIndex :Integer] : THandlerRegistrationItem Read GetH Write SetH; default;
+  end;
+
+  { TDebugCaptureService }
+
+  TDebugCaptureService = class(TComponent)
+  Private
+    class var _instance : TDebugCaptureService;
+  private
+    FCaptureToErrorLog: Boolean;
+    FCors: TCORSSupport;
+    FFileName: string;
+    FHandlers: THandlerRegistrationList;
+    FLogToConsole: Boolean;
+    FOnLog: TDebugCaptureLogHandler;
+    FCaptureStream : TStream;
+    procedure SetCaptureToErrorLog(AValue: Boolean);
+    procedure SetCors(AValue: TCORSSupport);
+    procedure SetLogFileName(const AValue: string);
+    procedure SetLogToConsole(AValue: Boolean);
+    function GetHandlerCount: Integer;
+  Protected
+    Procedure DoLog(aType : TEventType; const aMsg : String);
+    Procedure DoLog(aType : TEventType; const aFmt : String; args : Array of const);
+    function GetCaptureJSON(ARequest: TRequest; AResponse: TResponse; var aJSON: TJSONData): TJSONArray;
+    procedure DistributeCaptureOutput(aJSON: TJSONData); virtual;
+    procedure DoLogToConsole(aSender: TObject; aCapture: TJSONData); virtual;
+    procedure DoLogToErrorLog(aSender: TObject; aCapture: TJSONData); virtual;
+    procedure DoLogToFile(aSender: TObject; aCapture: TJSONData); virtual;
+    Function CreateRegistrationList : THandlerRegistrationList; virtual;
+    Property Handlers : THandlerRegistrationList Read FHandlers;
+  Public
+    Constructor Create(aOwner:TComponent); override;
+    Destructor Destroy; Override;
+    class constructor init;
+    class destructor done;
+    class Property Instance : TDebugCaptureService Read _Instance;
+    class function JSONDataToString(aJSON: TJSONData): TJSONStringType;
+    Procedure HandleRequest(ARequest: TRequest; AResponse: TResponse);
+    Procedure RegisterHandler(const aName : String; aHandler: TDebugCaptureHandler);
+    Procedure UnregisterHandler(const aName : String);
+    Property HandlerCount : Integer Read GetHandlerCount;
+    Property LogFileName : string Read FFileName Write SetLogFileName;
+    Property LogToConsole : Boolean Read FLogToConsole Write SetLogToConsole;
+    Property CaptureToErrorLog : Boolean Read FCaptureToErrorLog Write SetCaptureToErrorLog;
+    Property OnLog : TDebugCaptureLogHandler Read FOnLog Write FOnLog;
+    Property CORS : TCORSSupport Read FCors Write SetCors;
+  end;
+
+
+implementation
+
+{ THandlerRegistrationList }
+
+function THandlerRegistrationList.GetH(aIndex : Integer): THandlerRegistrationItem;
+begin
+  Result:=Items[aIndex] as THandlerRegistrationItem;
+end;
+
+procedure THandlerRegistrationList.SetH(aIndex : Integer; AValue: THandlerRegistrationItem);
+begin
+  Items[aIndex]:=aValue;
+end;
+
+function THandlerRegistrationList.IndexOf(const aName: string): Integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and Not SameText(GetH(Result).Name,aName) do
+    Dec(Result);
+end;
+
+function THandlerRegistrationList.Find(const aName: string): THandlerRegistrationItem;
+
+var
+  Idx : integer;
+
+begin
+  Result:=Nil;
+  Idx:=IndexOf(aName);
+  If Idx<>-1 then
+    Result:=GetH(Idx);
+end;
+
+function THandlerRegistrationList.Add(const aName: string; aHandler: TDebugCaptureHandler): THandlerRegistrationItem;
+begin
+  Result:=(Inherited Add) as THandlerRegistrationItem;
+  Result.Name:=aName;
+  Result.Handler:=aHandler;
+end;
+
+function TDebugCaptureService.GetCaptureJSON(ARequest: TRequest; AResponse: TResponse; var aJSON: TJSONData): TJSONArray;
+
+var
+  aJSONObj : TJSONObject absolute aJSON;
+  Cont : String;
+
+begin
+  Result:=Nil;
+  aJSON:=Nil;
+  try
+    Cont:=aRequest.Content;
+    aJSON:=GetJSON(Cont);
+    if aJSON.JSONType<>jtObject then
+      Raise EHTTP.Create('No JSON object in capture JSON');
+    Result:=aJSONObj.Get('lines',TJSONArray(Nil));
+    if Result=Nil then
+      begin
+      FreeAndNil(aJSON);
+      Raise EHTTP.Create('No lines element in capture JSON');
+      end;
+  except
+    On E : Exception do
+      begin
+      DoLog(etError,Format('Exception %s (%s) : Invalid capture content: not valid JSON: %s',[E.ClassName,E.Message,Copy(Cont,1,255)]));
+      aResponse.Code:=400;
+      aResponse.CodeText:='INVALID PARAM';
+      aResponse.SendResponse;
+      end;
+  end;
+end;
+
+procedure TDebugCaptureService.DoLogToErrorLog(aSender: TObject; aCapture: TJSONData);
+
+var
+  S : TJSONStringType;
+
+begin
+  S:=JSonDataToString(aCapture);
+  DoLog(etInfo,'Capture : '+S);
+end;
+
+procedure TDebugCaptureService.DoLogToConsole(aSender: TObject; aCapture: TJSONData);
+var
+  S : TJSONStringType;
+
+begin
+  S:=JSonDataToString(aCapture);
+  Try
+    Writeln('Debug capture: ',S);
+  except
+    On E : Exception Do
+      DoLog(etError,'Exception %s writing to console: %s',[E.ClassName,E.Message]);
+  end;
+end;
+
+procedure TDebugCaptureService.DoLogToFile(aSender: TObject; aCapture: TJSONData);
+
+var
+  S : TJSONStringType;
+
+begin
+  S:=JSonDataToString(aCapture)+sLineBreak;
+  if Assigned(FCaptureStream) then
+    Try
+      FCaptureStream.WriteBuffer(S[1],Length(S)*SizeOf(TJSONCharType));
+    except
+      On E : Exception Do
+        DoLog(etError,'Exception %s writing to file %s: %s',[E.ClassName,LogFileName,E.Message]);
+    end;
+end;
+
+function TDebugCaptureService.GetHandlerCount: Integer;
+begin
+  Result:=FHandlers.Count;
+end;
+
+Const
+  cCaptureToErrorLog = '$ErrorLog';
+  cCaptureToFile     = '$File';
+  cCaptureToConsole  = '$Console';
+
+procedure TDebugCaptureService.SetCaptureToErrorLog(AValue: Boolean);
+begin
+  if FCaptureToErrorLog=AValue then Exit;
+  FCaptureToErrorLog:=AValue;
+  if FCaptureToErrorLog then
+    RegisterHandler(cCaptureToErrorLog,@DoLogToErrorLog)
+  else
+    UnRegisterHandler(cCaptureToErrorLog);
+end;
+
+procedure TDebugCaptureService.SetCors(AValue: TCORSSupport);
+begin
+  if FCors=AValue then Exit;
+  FCors.Assign(AValue);
+end;
+
+procedure TDebugCaptureService.SetLogFileName(const AValue: string);
+begin
+  if FFileName=AValue then Exit;
+  if Assigned(FCaptureStream) then
+    FreeAndNil(FCaptureStream);
+  FFileName:=AValue;
+  if FFileName<>'' then
+    begin
+    FCaptureStream:=TFileStream.Create(FFileName,fmCreate or fmShareDenyWrite);
+    RegisterHandler(cCaptureToFile,@DoLogToFile)
+    end
+  else
+    UnRegisterHandler(cCaptureToFile);
+end;
+
+procedure TDebugCaptureService.SetLogToConsole(AValue: Boolean);
+begin
+  if FLogToConsole=AValue then Exit;
+  FLogToConsole:=AValue;
+  if FLogToConsole then
+    RegisterHandler(cCaptureToFile,@DoLogToConsole)
+  else
+    UnRegisterHandler(cCaptureToFile);
+end;
+
+procedure TDebugCaptureService.DoLog(aType: TEventType; const aMsg: String);
+begin
+  if Assigned(FOnLog) then
+    FOnLog(aType,aMsg);
+end;
+
+procedure TDebugCaptureService.DoLog(aType: TEventType; const aFmt: String; args: array of const);
+begin
+  if Assigned(FonLog) then
+    FonLog(aType,SafeFormat(aFmt,args));
+end;
+
+function TDebugCaptureService.CreateRegistrationList: THandlerRegistrationList;
+begin
+  Result:=THandlerRegistrationList.Create(Self,THandlerRegistrationItem);
+end;
+
+constructor TDebugCaptureService.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  FHandlers:=CreateRegistrationList;
+  FCors:=TCORSSupport.Create;
+end;
+
+destructor TDebugCaptureService.Destroy;
+begin
+  FreeAndNil(FCors);
+  FreeAndNil(FHandlers);
+  inherited Destroy;
+end;
+
+procedure TDebugCaptureService.DistributeCaptureOutput(aJSON : TJSONData);
+
+var
+  I : Integer;
+  H : THandlerRegistrationItem;
+
+begin
+  For I:=0 to FHandlers.Count-1 do
+    Try
+      H:=FHandlers[i];
+      H.Handler(Self,aJSON);
+    except
+      On E : Exception do
+        DoLog(etError,'Handler %s raised exception %s while handling debug capture: %s',[H.Name,E.ClassName,E.Message]);
+    end;
+end;
+
+procedure TDebugCaptureService.HandleRequest(ARequest: TRequest; AResponse: TResponse);
+
+Var
+  aJSON : TJSONData;
+  aArray : TJSONArray;
+  I : Integer;
+
+begin
+  if CORS.HandleRequest(aRequest,aResponse,[hcDetect,hcSend]) then
+    exit;
+  aJSON:=Nil;
+  aArray:=Nil;
+  try
+    aArray:=GetCaptureJSON(aRequest,aResponse,aJSON);
+    if aArray<>Nil then
+      begin
+      For I:=0 to aArray.Count-1 do
+        DistributeCaptureOutput(aArray[i]);
+      aResponse.Code:=200;
+      aResponse.CodeText:='OK';
+      aResponse.SendResponse;
+      end;
+  finally
+    aJSON.Free;
+  end;
+end;
+
+
+procedure TDebugCaptureService.RegisterHandler(const aName: String; aHandler: TDebugCaptureHandler);
+begin
+  If FHandlers.IndexOf(aName)<>-1  then
+    Raise EListError.CreateFmt('Duplicate name: %s',[aName]);
+  FHandlers.Add(aName,aHandler);
+end;
+
+procedure TDebugCaptureService.UnregisterHandler(const aName: String);
+
+var
+  Idx : integer;
+
+begin
+  Idx:=FHandlers.IndexOf(aName);
+  if Idx<>-1 then
+    FHandlers.Delete(Idx);
+end;
+
+class function TDebugCaptureService.JSONDataToString(aJSON : TJSONData): TJSONStringType;
+
+begin
+  if aJSON.JSONType in StructuredJSONTypes then
+    Result:=aJSON.AsJSON
+  else if aJSON.JSONType<>jtNull then
+    Result:=aJSON.AsString
+  else
+    Result:='null';
+end;
+
+class constructor TDebugCaptureService.init;
+
+begin
+  _instance:=TDebugCaptureService.Create(Nil);
+end;
+
+class destructor TDebugCaptureService.done;
+
+begin
+  FreeAndNil(_instance);
+end;
+
+end.
+