Skip to content
Newer
Older
100644 146 lines (127 sloc) 4.79 KB
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
1 /*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 */
18 /**
19 * Represents an uploaded file.
20 */
21 type Upload.file = {
22 /** Name of input corresponding to the uploaded file. */
23 name : string;
24
25 /** Name of the uploaded file. */
26 filename : string;
27
28 /** Content of the file. */
29 content : -> {partial:int}/{content:binary};
30
31 /** A function that allows to fold on headers. */
32 fold_headers : (forall('a). 'a, (string, string, 'a -> 'a) -> 'a)
33 }
34
35 /**
36 * Represents other (no file) fields of form.
37 */
38 type Upload.field = {
39 /** Name of field */
40 name : string;
41
42 /** Value of field */
43 value : string;
44 }
45
46 /**
47 * An uploaded data can be a file or a field.
48 */
49 type Upload.data = Upload.file / Upload.field
50
51 /**
52 * Configuration for create an uploader.
53 */
54 type Upload.config('result) = {
55 /** Parameters for the dynamic url was created by the upload
56 manager. */
57 url_parameters : DynamicResource.parameters
58
59 /** The xhtml inserted on upload form. Beware if you set this config
60 fields take care to add a submit button. */
61 body_form : xhtml
62
63 /** Initial result value. */
64 init_result : 'result
65
66 /** A function that fold on datas by incomming order. */
67 fold_datas : Upload.data, 'result -> 'result
68
69 /** Perform result of datas folding. */
70 perform_result : 'result -> void
71 }
72
73 /**
74 * This module provides one main [make] function which create an xhtml
75 * that allows to upload file(s) from client to server.
76 */
77 Upload = {{
78 /**
79 * The default configuration :
80 * - url_parameters : [{expiration={none} consumption={unlimited}
81 visibility={current_context}}]
82 * - fold_datas : return previous result, do nothing with data.
83 * - perform_result : do nothing with data
84 * - body_form : An xhtml that contains [<input type="file"
85 name="filename"/><input type="submit" value="Upload"/>]. It
86 be able to upload one file.
87 */
88 default_config(init_result:'result):Upload.config('result) = {
89 url_parameters = {expiration={none} consumption={unlimited} visibility={current_context}}
90 body_form = <input type="file" name="filename"/><input type="submit" value="Upload"/>
91 ~init_result
92 fold_datas(_data, result) = result
93 perform_result(_result) = void
94 }
95
96 /**
97 * Create an upload manager.
98 * TODO : Add more documentation...(dynamic resource etc...)
99 */
100 make(config:Upload.config) =
101 /* Save creation page context because iframe is another page. */
102 reset_context =
103 match ThreadContext.get({current})
104 | {key=~{client} request=_ details=_} ->
105 key = ~{client}
106 ( -> { ThreadContext.get({current}) with ~key })
107 | _ -> ( -> ThreadContext.get({current}))
108 /* The dynamic resource use for reply to upload. */
109 dynamic(request) =
110 @with_thread_context(reset_context(),
111 match HttpRequest.Generic.get_multipart(request) with
112 | {none} ->
113 Resource.error_page("Upload fail",
114 <h1>Unexpected load request</h1>, {forbidden})
115 | {some = multipart} ->
116 result = HttpRequest.Generic.fold_multipart(multipart, config.init_result,
117 (part, fh, acc ->
118 match part
119 | ~{filename name content} ->
120 /* An hack for forall, TODO make it proprely */
121 fold_headers = @unsafe_cast(fh)
122 file = ~{filename name content fold_headers}
123 config.fold_datas(file, acc)
124 | {name=_ value=_} as x->
125 config.fold_datas(x, acc)
126 )
127 )
128 do Scheduler.push(-> config.perform_result(result))
129 Resource.source("Upload success", "text/plain")
130 )
131 resource = Resource.dynamic(dynamic)
132 upload_url = DynamicResource.publish(resource, config.url_parameters)
133 idframe = Random.string(10)
134 <iframe name={idframe}
4f8969f [fix] stdlib: upload
Hugo Heuzard authored Jun 23, 2011
135 id={idframe} src="{fake_url}"
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
136 style="width:0;height:0;border:0px solid #fff;"/>
137 <form action="{upload_url}" id="upload_form" target={idframe}
138 method="post" enctype="multipart/form-data">
139 {config.body_form}
4f8969f [fix] stdlib: upload
Hugo Heuzard authored Jun 23, 2011
140 </form>;
141
142 @private dummy_page = Resource.raw_text("")
143 @private @publish
144 fake_url = DynamicResource.publish(dummy_page, {consumption={unlimited}; expiration={none}; visibility={shared}})
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
145 }}
Something went wrong with that request. Please try again.