Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
cduce
cduce
Commits
585648b4
Commit
585648b4
authored
Jul 10, 2013
by
Giuseppe Castagna
Browse files
Updated in order to upgrade cgi-scripts from netcgi1 to netcgi2
parent
1a360e64
Changes
5
Hide whitespace changes
Inline
Side-by-side
CHANGES
View file @
585648b4
current
* build: replaced netcgi2 for netcgi1
0.5.5
0.5.5
* Added load_xml_subst and print_xml_subst for namespaces substitution.
* Added load_xml_subst and print_xml_subst for namespaces substitution.
(necessary for Web Services with OcCDuce and CDuce_WS).
(necessary for Web Services with OcCDuce and CDuce_WS).
...
...
Makefile.distrib
View file @
585648b4
...
@@ -210,7 +210,7 @@ ifeq ($(PXP),true)
...
@@ -210,7 +210,7 @@ ifeq ($(PXP),true)
PACKAGES
+=
$(PXP_PACK)
PACKAGES
+=
$(PXP_PACK)
ifeq
($(CGI),true)
ifeq
($(CGI),true)
OBJECTS
+=
runtime/cduce_pxp.cmo
OBJECTS
+=
runtime/cduce_pxp.cmo
PACKAGES
+=
netcgi
1
PACKAGES
+=
netcgi
2
ALL_TARGET
+=
dtd2cduce
ALL_TARGET
+=
dtd2cduce
INSTALL_BINARIES
+=
dtd2cduce
INSTALL_BINARIES
+=
dtd2cduce
endif
endif
...
@@ -265,7 +265,7 @@ cduce_lib.$(EXTENSION_LIB): $(OBJECTS:.cmo=.$(EXTENSION))
...
@@ -265,7 +265,7 @@ cduce_lib.$(EXTENSION_LIB): $(OBJECTS:.cmo=.$(EXTENSION))
dtd2cduce
:
tools/dtd2cduce.ml
dtd2cduce
:
tools/dtd2cduce.ml
@
echo
"Build
$@
"
@
echo
"Build
$@
"
$(HIDE)$(OCAMLFIND)
$(CAML)
-o
$@
-package
"
$(PXP_PACK)
netcgi
1
"
-linkpkg
$^
$(HIDE)$(OCAMLFIND)
$(CAML)
-o
$@
-package
"
$(PXP_PACK)
netcgi
2
"
-linkpkg
$^
.PHONY
:
compute_depend
.PHONY
:
compute_depend
compute_depend
:
$(DEPEND_OCAMLDEP)
compute_depend
:
$(DEPEND_OCAMLDEP)
...
...
configure.ml
View file @
585648b4
...
@@ -211,7 +211,7 @@ let pxp = check_feature "pxp" (check_pkg "pxp")
...
@@ -211,7 +211,7 @@ let pxp = check_feature "pxp" (check_pkg "pxp")
let
expat
=
check_feature
"expat"
(
check_pkg
"expat"
)
let
expat
=
check_feature
"expat"
(
check_pkg
"expat"
)
let
curl
=
check_feature
"curl"
(
check_pkg
"curl"
)
let
curl
=
check_feature
"curl"
(
check_pkg
"curl"
)
let
netclient
=
check_feature
"netclient"
(
check_pkg
"netclient"
)
let
netclient
=
check_feature
"netclient"
(
check_pkg
"netclient"
)
let
cgi
=
check_feature
"cgi"
(
check_pkg
"netcgi
1
"
)
let
cgi
=
check_feature
"cgi"
(
check_pkg
"netcgi
2
"
)
let
pxp_wlex
=
check_feature
"pxp_wlex"
(
check_pkg
"pxp-wlex-utf8"
)
let
pxp_wlex
=
check_feature
"pxp_wlex"
(
check_pkg
"pxp-wlex-utf8"
)
let
prefix
=
dir
"prefix"
let
prefix
=
dir
"prefix"
let
bindir
=
dir
~
def
:
(
prefix
^
"/bin"
)
"bindir"
let
bindir
=
dir
~
def
:
(
prefix
^
"/bin"
)
"bindir"
...
...
driver/webiface.ml
View file @
585648b4
...
@@ -5,21 +5,13 @@
...
@@ -5,21 +5,13 @@
open
Netcgi
open
Netcgi
exception
Timeout
exception
Timeout
let
config
=
Netcgi
.
default_config
let
cgi
_
ch
=
new
Netchannels
.
buffered_trans_channel
ch
(*
let operating_type = Netcgi.buffered_transactional_optype
let operating_type = Netcgi.buffered_transactional_optype
let cgi = new Netcgi.std_activation ~operating_type ()
let cgi = new Netcgi.std_activation ~operating_type ()
*)
let
fatal_error
title
s
=
cgi
#
output
#
rollback_work
()
;
cgi
#
set_header
~
content_type
:
"text/html; charset=
\"
iso-8859-1
\"
"
~
cache
:
`No_cache
()
;
cgi
#
output
#
output_string
(
"<h1>"
^
title
^
"</h1>"
);
cgi
#
output
#
output_string
s
;
cgi
#
output
#
output_string
"
\n
"
;
cgi
#
output
#
commit_work
()
;
cgi
#
finalize
()
;
exit
0
(* Loading examples *)
(* Loading examples *)
...
@@ -36,12 +28,12 @@ let (||=) p () = ()
...
@@ -36,12 +28,12 @@ let (||=) p () = ()
let
html_header
p
=
let
html_header
p
=
p
"
p
"
<?xml version=
\"
1.0
\"
encoding=
\"
iso-8859-1
\"
?>
<?xml version=
\"
1.0
\"
encoding=
\"
UTF-*
\"
?>
<!DOCTYPE html PUBLIC
\"
-//W3C//DTD XHTML 1.0 Transitional//EN
\"
<!DOCTYPE html PUBLIC
\"
-//W3C//DTD XHTML 1.0 Transitional//EN
\"
\"
http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd
\"
>
\"
http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd
\"
>
<html>
<html>
<head>
<head>
<meta content=
\"
text/html; charset=
iso-8859-1
\"
<meta content=
\"
text/html
\"
; charset=
\"
UTF-8
\"
http-equiv=
\"
Content-Type
\"
/>
http-equiv=
\"
Content-Type
\"
/>
<link type=
\"
text/css
\"
href=
\"
/cduce.css
\"
rel=
\"
stylesheet
\"
/>
<link type=
\"
text/css
\"
href=
\"
/cduce.css
\"
rel=
\"
stylesheet
\"
/>
<title>CDuce online prototype</title>
<title>CDuce online prototype</title>
...
@@ -116,9 +108,21 @@ let cut p w s =
...
@@ -116,9 +108,21 @@ let cut p w s =
in
in
aux
0
0
aux
0
0
let
main
(
cgi
:
Netcgi
.
std_activation
)
=
let
main
(
cgi
:
Netcgi
.
cgi
)
=
let
p
=
cgi
#
out
put
#
output_string
in
let
p
=
cgi
#
out
_channel
#
output_string
in
let
clicked
s
=
cgi
#
argument_value
s
<>
""
in
let
clicked
s
=
cgi
#
argument_value
s
<>
""
in
let
fatal_error
title
s
=
cgi
#
out_channel
#
rollback_work
()
;
cgi
#
set_header
~
content_type
:
"text/html
\"
; charset=
\"
UTF-8
\"
"
~
cache
:
`No_cache
()
;
cgi
#
out_channel
#
output_string
(
"<h1>"
^
title
^
"</h1>"
);
cgi
#
out_channel
#
output_string
s
;
cgi
#
out_channel
#
output_string
"
\n
"
;
cgi
#
out_channel
#
commit_work
()
;
cgi
#
finalize
()
;
exit
0
in
try
try
cgi
#
set_header
()
;
cgi
#
set_header
()
;
...
@@ -139,7 +143,7 @@ let main (cgi : Netcgi.std_activation) =
...
@@ -139,7 +143,7 @@ let main (cgi : Netcgi.std_activation) =
if
ok
then
Format
.
fprintf
ppf
"@
\n
Ok.@
\n
"
;
if
ok
then
Format
.
fprintf
ppf
"@
\n
Ok.@
\n
"
;
let
res
=
Html
.
get
v
in
let
res
=
Html
.
get
v
in
p
"<div class=
\"
box
\"
><h2>Results</h2><pre>"
;
p
"<div class=
\"
box
\"
><h2>Results</h2><pre>"
;
cut
(
cgi
#
out
put
#
output_char
)
80
res
;
cut
(
cgi
#
out
_channel
#
output_char
)
80
res
;
p
"</pre></div>"
;
p
"</pre></div>"
;
dialog
src
dialog
src
in
in
...
@@ -160,7 +164,7 @@ CDuce is under active development; some features may not work properly.
...
@@ -160,7 +164,7 @@ CDuce is under active development; some features may not work properly.
<p>Prototype version "
^
<:
symbol
<
cduce_version
>>
^
",
<p>Prototype version "
^
<:
symbol
<
cduce_version
>>
^
",
built on "
^
<:
symbol
<
build_date
>>
^
".</p></div>"
);
built on "
^
<:
symbol
<
build_date
>>
^
".</p></div>"
);
html_footer
p
;
html_footer
p
;
cgi
#
out
put
#
commit_work
()
cgi
#
out
_channel
#
commit_work
()
with
with
exn
->
exn
->
let
msg
=
let
msg
=
...
@@ -180,6 +184,6 @@ let () =
...
@@ -180,6 +184,6 @@ let () =
ignore
(
Unix
.
alarm
20
);
ignore
(
Unix
.
alarm
20
);
Sys
.
set_signal
Sys
.
sigalrm
(
Sys
.
Signal_handle
(
fun
_
->
raise
Timeout
));
Sys
.
set_signal
Sys
.
sigalrm
(
Sys
.
Signal_handle
(
fun
_
->
raise
Timeout
));
Random
.
self_init
()
;
Random
.
self_init
()
;
main
cgi
;
Netcgi_cgi
.
run
~
config
~
output_type
:
(
`Transactional
cgi
)
main
;
cgi
#
finalize
()
tools/dtd2cduce.ml
View file @
585648b4
...
@@ -94,28 +94,28 @@ let import_dtd ppf name src =
...
@@ -94,28 +94,28 @@ let import_dtd ppf name src =
"(* This file has been automatically generated by dtd2cduce *)@
\n
"
;
"(* This file has been automatically generated by dtd2cduce *)@
\n
"
;
List
.
iter
(
fun
x
->
elt
ppf
(
dtd
#
element
x
))
(
dtd
#
element_names
)
List
.
iter
(
fun
x
->
elt
ppf
(
dtd
#
element
x
))
(
dtd
#
element_names
)
let
main
(
cgi
:
Netcgi
.
std_activation
)
=
let
main
(
cgi
:
Netcgi
.
cgi
)
=
try
try
cgi
#
set_header
cgi
#
set_header
~
content_type
:
"text/plain; charset=
\"
iso-8859-1
\"
"
~
content_type
:
"text/plain
\"
; charset=
\"
UTF-8
\"
"
()
;
()
;
let
dtd
=
cgi
#
argument_value
"dtd"
in
let
dtd
=
cgi
#
argument_value
"dtd"
in
let
prefix
=
cgi
#
argument_value
"prefix"
in
let
prefix
=
cgi
#
argument_value
"prefix"
in
import_dtd
Format
.
str_formatter
(
fun
s
->
prefix
^
s
)
import_dtd
Format
.
str_formatter
(
fun
s
->
prefix
^
s
)
(
from_string
dtd
);
(
from_string
dtd
);
let
res
=
Format
.
flush_str_formatter
()
in
let
res
=
Format
.
flush_str_formatter
()
in
cgi
#
out
put
#
output_string
res
;
cgi
#
out
_channel
#
output_string
res
;
cgi
#
out
put
#
commit_work
()
;
cgi
#
out
_channel
#
commit_work
()
;
with
exn
->
with
exn
->
cgi
#
out
put
#
rollback_work
()
;
cgi
#
out
_channel
#
rollback_work
()
;
cgi
#
set_header
cgi
#
set_header
~
content_type
:
"text/plain; charset=
\"
iso-8859-1
\"
"
~
content_type
:
"text/plain
\"
; charset=
\"
UTF-8
\"
"
()
;
()
;
let
s
=
Pxp_types
.
string_of_exn
exn
in
let
s
=
Pxp_types
.
string_of_exn
exn
in
cgi
#
out
put
#
output_string
"ERROR:
\n
"
;
cgi
#
out
_channel
#
output_string
"ERROR:
\n
"
;
cgi
#
out
put
#
output_string
s
;
cgi
#
out
_channel
#
output_string
s
;
cgi
#
out
put
#
output_string
"
\n
"
;
cgi
#
out
_channel
#
output_string
"
\n
"
;
cgi
#
out
put
#
commit_work
()
cgi
#
out
_channel
#
commit_work
()
let
()
=
let
()
=
...
@@ -124,12 +124,11 @@ let () =
...
@@ -124,12 +124,11 @@ let () =
let
name
s
=
Sys
.
argv
.
(
1
)
^
s
in
let
name
s
=
Sys
.
argv
.
(
1
)
^
s
in
import_dtd
Format
.
std_formatter
name
(
from_file
Sys
.
argv
.
(
2
))
import_dtd
Format
.
std_formatter
name
(
from_file
Sys
.
argv
.
(
2
))
|
1
->
|
1
->
let
operating_type
=
Netcgi
.
buffered_transactional_optype
in
let
config
=
Netcgi
.
default_config
in
let
cgi
=
new
Netcgi
.
std_activation
~
operating_type
()
in
let
buffered
_
ch
=
new
Netchannels
.
buffered_trans_channel
ch
in
ignore
(
Unix
.
alarm
20
);
ignore
(
Unix
.
alarm
20
);
Sys
.
set_signal
Sys
.
sigalrm
(
Sys
.
Signal_handle
(
fun
_
->
raise
Timeout
));
Sys
.
set_signal
Sys
.
sigalrm
(
Sys
.
Signal_handle
(
fun
_
->
raise
Timeout
));
main
cgi
;
Netcgi_cgi
.
run
~
config
~
output_type
:
(
`Transactional
buffered
)
main
cgi
#
finalize
()
|
_
->
|
_
->
prerr_endline
"Usage: dtd2cduce <prefix> <.dtd file>"
;
prerr_endline
"Usage: dtd2cduce <prefix> <.dtd file>"
;
exit
2
exit
2
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment