1%%%------------------------------------------------------------------- 2%%% File : yaws_appmod_dav.erl 3%%% Created : 11 Nov 2012 4%%% Purpose : WebDav module, RFC4918 class 1, 2, 3 compliant 5%%% 6%%% To use, add the following configuration: 7%%% 8%%% <server> 9%%% ... 10%%% dav = true 11%%% </server> 12%%% 13%%% This configuration is short for: 14%%% 15%%% runmod = yaws_runmod_lock 16%%% ... 17%%% <server> 18%%% ... 19%%% appmods = </, yaws_appmod_dav> 20%%% <server> 21%%% 22%%% Todo : 1) Add header handling (most of the time not used by DAV 23%%% clients): 24%%% If-Match, If-Modified-Since, If-None-Match, 25%%% If-Range, If-Unmodified-Since, TE 26%%% 2) POST on collections 27%%%------------------------------------------------------------------- 28 29-module(yaws_appmod_dav). 30 31%% for appmod: 32-export([out/1]). 33 34%% for replacement xmerl_xml: 35-export([export/1]). 36-import(xmerl_lib, [markup/3, empty_tag/2, export_text/1]). 37 38 39-ifdef(debug). 40-define(DEBUG(X), io:format(X)). 41-define(DEBUG(X,Y), io:format(X,Y)). 42-else. 43-define(DEBUG(X), true). 44-define(DEBUG(X,Y), true). 45-endif. 46 47-include("../include/yaws_dav.hrl"). 48-include("../include/yaws_lock.hrl"). 49-include("../include/yaws_api.hrl"). 50-include("../include/yaws.hrl"). 51-include("yaws_debug.hrl"). 52-include_lib("xmerl/include/xmerl.hrl"). 53-include_lib("kernel/include/file.hrl"). 54 55out(A) -> 56 try 57 h_litmus(A), 58 %% handle the request 59 R = A#arg.req, 60 Method = R#http_request.method, 61 H = A#arg.headers, 62 C = if 63 H#headers.user_agent == undefined -> standard; 64 true -> 65 Ms = string:str(H#headers.user_agent,"Microsoft"), 66 if 67 Ms > 0 -> microsoft; 68 true -> standard 69 end 70 end, 71 put(compatibility,C), 72 handle(Method,A) 73 catch 74 {Status,Precondition} -> 75 Response1 = [{'D:error', [{'xmlns:D',"DAV:"}], 76 [{Precondition,[],[]}]}], 77 status(Status,{xml,Response1}); 78 Status -> 79 status(Status); 80 _Error:{noproc,{gen_server,call,[yaws_runmod_lock|_Whatever]}} -> 81 Msg = "Lock server not started. See documentation.~n", 82 error_logger:error_msg(Msg), 83 Response = [{'D:error',[{'xmlns:D',"DAV:"}],[Msg]}], 84 status(500,{xml,Response}); 85 ?MAKE_ST(_Error:Reason,ST, 86 begin 87 error_logger:info_msg("unexpected error: ~p~n~p~n", 88 [Reason, ST]), 89 Response = [{'D:error',[{'xmlns:D',"DAV:"}],[Reason]}], 90 status(500,{xml,Response}) 91 end) 92 end. 93 94%%------------------------------------------------------ 95%% handle methods 96%% 97handle('OPTIONS',A) -> 98 ?DEBUG("OPTIONS"), 99 R = davresource0(A), 100 F = R#resource.info, 101 T = case F#file_info.type of 102 directory -> "httpd/unix-directory"; 103 _ -> 104 Name = R#resource.name, 105 Ext = filename:extension(Name), 106 Ext1 = case Ext of 107 [] -> ""; 108 _ -> tl(Ext) 109 end, 110 {_Kind,Mimetype} = mime_types:t(Ext1), 111 Mimetype 112 end, 113 Headers = [{header,{"Allow", 114 "GET, POST, OPTIONS, HEAD, PUT, DELETE, " 115 "PROPFIND, PROPPATCH, LOCK, UNLOCK, " 116 "MKCOL, MOVE, COPY"}}], 117 status(200,[{header,{"Content-Type",T}}|Headers],[]); 118handle('HEAD',A) -> 119 ?DEBUG("HEAD ~p",[A#arg.server_path]), 120 Path = davpath(A), 121 case file:read_file_info(Path) of 122 {ok, F} when (F#file_info.type == regular) -> 123 E = yaws:make_etag(F), 124 Name = A#arg.server_path, 125 Ext = filename:extension(Name), 126 Ext1 = case Ext of 127 [] -> ""; 128 _ -> tl(Ext) 129 end, 130 {_Kind,T} = mime_types:t(Ext1), 131 status(200,[{header,{"Etag",E}},{header,{"Content-Type",T}}]); 132 {ok, F} when (F#file_info.type == directory) -> 133 status(200,[{header,{"Content-Type","httpd/unix-directory"}}]); 134 _ -> throw(404) 135 end; 136handle('GET',A) -> 137 ?DEBUG("GET ~p",[A#arg.server_path]), 138 Name = A#arg.server_path, 139 Path = A#arg.fullpath, 140 Pid = self(), 141 SC=get(sc), 142 PPS = SC#sconf.partial_post_size, 143 case file:read_file_info(Path) of 144 {ok,F} when F#file_info.type==directory -> 145 {ok,Dir} = file:list_dir(Path), 146 Listing = lists:foldl( 147 fun(Fname,L) -> 148 {ok,Finfo} = file:read_file_info( 149 filename:join(Path,Fname)), 150 Ftype = case Finfo#file_info.type of 151 directory -> "Coll:"; 152 _ -> " " 153 end, 154 Fsize = integer_to_list(Finfo#file_info.size), 155 Ftime = yaws:local_time_as_gmt_string( 156 Finfo#file_info.mtime), 157 Entry = io_lib:format("~s ~-20s ~10s ~s~n", 158 [Ftype,Fname,Fsize,Ftime]), 159 L++Entry 160 end,"",lists:sort(Dir)), 161 Response = {ehtml,[ 162 {html,[],[ 163 {head,[],[ 164 {title,[],Name}] 165 }, 166 {body,[],[ 167 {h2,[],"Index of "++Name}, 168 {pre,[],Listing}] 169 }] 170 }] 171 }, 172 status(200,Response); 173 {ok,F} -> 174 Size = integer_to_list(F#file_info.size), 175 Ext = filename:extension(Name), 176 Ext1 = case Ext of 177 [] -> ""; 178 _ -> tl(Ext) 179 end, 180 {_Kind,Mimetype} = mime_types:t(Ext1), 181 H = [{header,{"Content-Length",Size}}], 182 {ok,Fd} = file:open(Path,[read,binary]), 183 case file:read(Fd,PPS) of 184 {ok,Data} when size(Data)<PPS -> 185 ?DEBUG("only chunk~n"), 186 status(200,H,{content,Mimetype,Data}); 187 {ok,Data} -> 188 ?DEBUG("first chunk~n"), 189 spawn(fun() -> deliver_rest(Pid,Fd) end), 190 status(200,H,{streamcontent,Mimetype,Data}); 191 eof -> 192 status(200,{content,"application/octet-stream",<<>>}); 193 {error,Reason} -> 194 Response = [{'D:error',[{'xmlns:D',"DAV:"}],[Reason]}], 195 status(500,{xml,Response}) 196 end; 197 {error,enoent} -> 198 status(404); 199 _Other -> 200 status(500) 201 end; 202handle('POST',A) -> 203 ?DEBUG("POST ~p",[A#arg.server_path]), 204 _Path = davpath(A), 205 %% TODO POST for collections: RFC5995 206 status(501); 207handle("LOCK",A) -> 208 %% TODO Multi resource lock (lock on collection) returns 207 209 %% (multi-status) when failing 210 ?DEBUG("LOCK ~p",[A#arg.server_path]), 211 Name = A#arg.server_path, 212 Path = davpath(A), 213 %% check if file/collection exists and create if not so 214 %% RFC4918 - 9.10.4 215 {Status,R} = case file:read_file_info(Path) of 216 {ok, F} when (F#file_info.type == directory) or 217 (F#file_info.type == regular) -> 218 {200,#resource{ name = Name, info = F}}; 219 {error,enoent} -> 220 case string:right(A#arg.server_path,1) of 221 "/" -> 222 ok = file:make_dir(Path); 223 _ -> 224 ok = file:write_file(Path,"") 225 end, 226 {ok, F} = file:read_file_info(Path), 227 {201,#resource{ name = Name, info = F}}; 228 {error,_} -> throw(409) 229 end, 230 Req = binary_to_list(A#arg.clidata), 231 L = parse_lockinfo(Req), 232 %%Id = h_locktoken(A), 233 Timeout = h_timeout(A), 234 Depth = h_depth(A), 235 Id = h_if_refresh(A,Path), 236 case yaws_runmod_lock:lock(Path,L#lock{path=Path,id=Id,timeout=Timeout, 237 depth=Depth}) of 238 {ok,Id1} -> 239 {200,Result} = prop_get({'DAV:',lockdiscovery},A,R), 240 Response = [{'D:prop', [{'xmlns:D',"DAV:"}], [Result]}], 241 status(Status,[{header, 242 {"Lock-Token","<opaquelocktoken:"++Id1++">"}}], 243 {xml,Response}); 244 {error,locked} -> 245 status(423); 246 _ -> 247 throw(501) 248 end; 249handle("UNLOCK",A) -> 250 ?DEBUG("UNLOCK ~p",[A#arg.server_path]), 251 Path = davpath(A), 252 Id = h_locktoken(A), 253 %%?DEBUG(" Id=~p",[Id]), 254 case yaws_runmod_lock:unlock(Path,Id) of 255 ok -> status(204); 256 not_found -> 257 Response = [{'D:error', [{'xmlns:D',"DAV:"}], 258 [{'lock-token-matches-request-uri',[],[]}]}], 259 status(409,{xml,Response}) 260 end; 261handle('DELETE',A) -> 262 ?DEBUG("DELETE ~p",[A#arg.server_path]), 263 Path = davpath(A), 264 h_if(A,Path), 265 R = davresource0(A), 266 %% use internal locking to be safe 267 case yaws_runmod_lock:lock(R#resource.name, 268 #lock{depth=infinity,scope=exclusive}) of 269 {ok,Id} -> 270 F = filename:join(A#arg.docroot,["./",R#resource.name]), 271 fs_rmrf(F), 272 yaws_runmod_lock:unlock(R#resource.name,Id), 273 status(200); 274 _ -> throw(423) 275 end; 276handle('PUT',A) when A#arg.state == undefined -> 277 ?DEBUG("PUT ~p",[A#arg.server_path]), 278 Path = davpath(A), 279 h_if(A,Path), 280 case filelib:is_dir(Path) of 281 true -> 282 throw(405); 283 false -> 284 TmpName = temp_name(Path), 285 X = file:open(TmpName, [raw,write]), 286 case X of 287 {ok, Fd} -> 288 State = #upload{fd=Fd, filename=Path, tempname=TmpName}, 289 case A#arg.clidata of 290 {partial,Bin} -> 291 file:write(Fd,Bin), 292 {get_more,<<>>,State}; 293 Bin -> 294 file:write(Fd,Bin), 295 file:close(Fd), 296 case file:rename(TmpName, Path) of 297 ok -> status(201); 298 _ -> status(409) 299 end 300 end; 301 {error,eexist} -> 302 throw(405); 303 {error,enoent} -> throw(409); 304 {error,eisdir} -> throw(409); 305 {error,enospace} -> throw(507); 306 _ -> status(500) 307 end 308 end; 309handle('PUT',A) -> 310 State = A#arg.state, 311 Fd = State#upload.fd, 312 case A#arg.clidata of 313 {partial,Bin} -> 314 file:write(Fd,Bin), 315 {get_more,<<>>,State}; 316 Bin -> 317 file:write(Fd,Bin), 318 file:close(Fd), 319 FName = State#upload.filename, 320 TmpName = State#upload.tempname, 321 case file:rename(TmpName, FName) of 322 ok -> status(201); 323 _ -> status(409) % TODO delete temp file here? 324 end 325 end; 326handle("MKCOL",A) -> 327 ?DEBUG("MKCOL ~p",[A#arg.server_path]), 328 Path = davpath(A), 329 if 330 %% RFC2518, 8.3.1 331 size(A#arg.clidata) > 0 -> throw(415); 332 true -> ok 333 end, 334 h_if(A,Path), 335 file_do(make_dir,[Path]), 336 status(201); 337handle("COPY",A) -> 338 ?DEBUG("COPY ~p",[A#arg.server_path]), 339 From = A#arg.fullpath, 340 Dest = h_destination(A), 341 To = case {string:right(Dest,1),string:right(Dest,1)} of 342 {"/",_} -> Dest; 343 {_,"/"} -> filename:join(Dest,filename:basename(From)); 344 _ -> Dest 345 end, 346 DoOverwrite = h_overwrite(A), 347 ToExists = exists(To), 348 if 349 DoOverwrite == false, ToExists == true -> 350 status(412); 351 true -> 352 if ToExists == true -> 353 h_if(A,To), 354 fs_rmrf(To), 355 fs_cp(From,To), 356 status(204); 357 true -> 358 fs_cp(From,To), 359 status(201) 360 %%status(201,[{'Location',To}],[]) 361 end 362 end; 363handle("MOVE",A) -> 364 ?DEBUG("MOVE ~p",[A#arg.server_path]), 365 From = davpath(A), 366 h_if(A,From), 367 Dest = h_destination(A), 368 To = case {string:right(Dest,1),string:right(Dest,1)} of 369 {"/",_} -> Dest; 370 {_,"/"} -> filename:join(Dest,filename:basename(From)); 371 _ -> Dest 372 end, 373 DoOverwrite = h_overwrite(A), 374 ToExists = exists(To), 375 if 376 DoOverwrite == false, ToExists == true -> 377 status(412); 378 true -> 379 if 380 ToExists == true -> 381 h_if(A,To), 382 fs_rmrf(To); 383 true -> 384 ok 385 end, 386 case file:rename(From, To) of 387 ok when ToExists == true -> 388 status(204); 389 ok -> 390 status(201); 391 _ -> 392 try 393 fs_cp(From, To), 394 fs_rmrf(From), 395 status(201) 396 catch 397 throw:Status -> 398 ?DEBUG(" move from ~p to ~p failed: ~p\n", 399 [From, To, Status]), 400 Response = [{'D:error', [{'xmlns:D',"DAV:"}], 401 [Status]}], 402 status(Status,{xml,Response}) 403 end 404 end 405 end; 406handle("PROPFIND",A) -> 407 ?DEBUG("PROPFIND ~p",[A#arg.server_path]), 408 Req = binary_to_list(A#arg.clidata), 409 Props = parse_propfind(Req), 410 R = davresource0(A), 411 case h_depth(A) of 412 0 -> 413 Response = {'D:response', [], propfind_response(Props,A,R)}, 414 MultiStatus = [{'D:multistatus', [{'xmlns:D',"DAV:"}], [Response]}], 415 status(207,{xml,MultiStatus}); 416 1 -> 417 R1 = davresource1(A), 418 Response = {'D:response', [], propfind_response(Props,A,R)}, 419 Responses = [{'D:response', [], 420 propfind_response(Props,A,Rx)} || Rx <- R1], 421 MultiStatus = [{'D:multistatus', [{'xmlns:D',"DAV:"}], 422 [Response|Responses]}], 423 status(207,{xml,MultiStatus}); 424 infinity -> 425 Response = [{'D:error', [{'xmlns:D',"DAV:"}], 426 [{'propfind-finite-depth',[],[]}]}], 427 status(403,{xml,Response}) 428 end; 429handle("PROPPATCH",A) -> 430 ?DEBUG("PROPPATCH ~p",[A#arg.server_path]), 431 Path = davpath(A), 432 h_if(A,Path), 433 Req = binary_to_list(A#arg.clidata), 434 R = davresource0(A), 435 Update = parse_proppatch(Req), 436 Response = {'D:response',[],proppatch_response(Update,A,R)}, 437 MultiStatus = [{'D:multistatus', [{'xmlns:D',"DAV:"}], [Response]}], 438 status(207,{xml,MultiStatus}); 439handle(_Other,_A) -> 440 status(405). 441 442 443%% -------------------------------------------------------- 444%% File functions 445%% 446 447%% deliver chunked data 448deliver_rest(Pid,Fd) -> 449 case file:read(Fd,10240) of 450 {ok, Data} -> 451 yaws_api:stream_chunk_deliver(Pid,Data), 452 deliver_rest(Pid,Fd); 453 eof -> 454 yaws_api:stream_chunk_end(Pid), 455 file:close(Fd); 456 {error,Reason} -> 457 exit(Reason) 458 end. 459 460%% do a recoverable/catchable file function 461file_do(Func,Params) -> 462 Result = erlang:apply(file,Func,Params), 463 case Result of 464 ok -> ok; 465 {ok,X} -> {ok,X}; 466 {ok,X1,X2} -> {ok,X1,X2}; 467 eof -> eof; 468 {error,eexist} -> throw(405); 469 {error,enoent} -> throw(409); 470 {error,eisdir} -> throw(409); 471 {error,enospace} -> throw(507); 472 _Error -> ?DEBUG("file function returned ~p~n",[_Error]),throw(500) 473 end. 474 475%% recursive remove, equivalent of rm -rf 476fs_rmrf(Path) -> 477 {ok, F} = file_do(read_file_info,[Path]), 478 case F#file_info.type of 479 directory -> 480 {ok, Dir} = file_do(list_dir,[Path]), 481 [ fs_rmrf(filename:join(Path,File)) || File <- Dir ], 482 ok = file:del_dir(Path); 483 %%file_do(del_dir,[Path]); 484 _ -> 485 ok = file:delete(Path) 486 %%file_do(delete,[Path]) 487 end. 488 489%% recursive copy, equivalent of cp 490fs_cp(From,To) -> 491 %% All checks on existence of the destination have to be done before 492 %% so destination should not exist 493 {ok, F} = file:read_file_info(From), 494 case F#file_info.type of 495 directory -> 496 file_do(make_dir,[To]), 497 {ok, Dir} = file:list_dir(From), 498 [ fs_cp(filename:join(From,File),filename:join(To,File)) || 499 File <- Dir ]; 500 _ -> 501 file_do(copy,[From,To]) 502 end. 503 504%% check existence 505exists(Path) -> 506 case file:read_file_info(Path) of 507 {ok, _} -> true; 508 _ -> false 509 end. 510 511%% generate a temporary filename as a dotted file with a timestamp 512temp_name(F) -> 513 {A,B,C} = yaws:get_time_tuple(), 514 Path = filename:dirname(F), 515 File = filename:basename(F), 516 T0 = io_lib:format("~s/.~s.~p-~p-~p",[Path,File,A,B,C]), 517 lists:flatten(T0). 518 519%% -------------------------------------------------------- 520%% Property functions 521%% 522 523%% propfind response 524propfind_response(Props,A,R) -> 525 Url = yaws_api:url_encode(R#resource.name), 526 case Props of 527 [allprop] -> 528 AllProp = [ prop_get(N,A,R) || N <- allprops(R) ], 529 AllSorted = prop_sort(AllProp), 530 {200, Results} = lists:keyfind(200,1,AllSorted), 531 [{'D:href', [], [Url]}, 532 {'D:propstat', [], [ 533 {'D:prop', [], Results},{status, [],["HTTP/1.1 200 OK"]} 534 ]}]; 535 [propname] -> 536 Results = [ case NS of 537 'DAV:' -> {list_to_atom("D:"++atom_to_list(P)),[],[]}; 538 _ -> {P,[{'xmlns',NS}],[]} 539 end 540 || {NS,P} <-allprops(R) ], 541 [{'D:href', [], [Url]}, 542 {'D:propstat', [], [ 543 {'D:prop', [], Results},{status, [],["HTTP/1.1 200 OK"]} 544 ]}]; 545 PropsRequested -> 546 Results = [ prop_get(N,A,R) || {N,_} <- PropsRequested ], 547 ResultsSorted = prop_sort(Results), 548 [{'D:href', [], [Url]}| 549 [{'D:propstat', [], [ 550 {'D:prop', [], PropsFound},prop_status(Status) 551 ]} || {Status,PropsFound} <- ResultsSorted ] 552 ] 553 end. 554 555%% proppatch response/ 556proppatch_response(Update,A,R) -> 557 Url = yaws_api:url_encode(R#resource.name), 558 Results = proppatch_response(Update,A,R,[]), 559 ResultsSorted = prop_sort(lists:flatten(Results)), 560 [{'D:href', [], [Url]}| 561 [{'D:propstat', [], [ 562 {'D:prop', [], PropsFound},prop_status(Status) 563 ]} || {Status,PropsFound} <- ResultsSorted ] 564 ]. 565proppatch_response([H|T],A,R,Results) -> 566 Result = case H of 567 {set,Props} -> [ prop_set(P,A,R,V) || {P,V} <- Props]; 568 {remove,Props} -> [ prop_remove(P,A,R) || {P,_V} <- Props] 569 end, 570 proppatch_response(T,A,R,[Result|Results]); 571proppatch_response([],_A,_R,Results) -> 572 Results. 573 574prop_sort(L) -> prop_sort(L,[]). 575prop_sort([H|T],R) -> 576 {Status,Prop} = H, 577 R1 = case lists:keyfind(Status,1,R) of 578 {Status, Props} -> lists:keystore(Status,1,R,{Status,[Prop|Props]}); 579 false -> lists:keystore(Status,1,R,{Status,[Prop]}) 580 end, 581 prop_sort(T,R1); 582prop_sort([],R) -> R. 583 584 585prop_status(Status) -> 586 {'D:status',[],["HTTP/1.1 " ++ integer_to_list(Status) ++ " " ++ 587 yaws_api:code_to_phrase(Status)]}. 588 589 590%% Available props include namespace 591%% Available props can differ per resource 592%% For proposed Microsoft extensions see: draft-hopmann-collection-props-00.txt 593%% 594allprops(R) -> 595 F = R#resource.info, 596 C = get(compatibility), 597 %% default property set 598 P1 = [ 599 {'http://yaws.hyber.org/',access}, % sample Yaws extension 600 {'DAV:',creationdate}, 601 %%{'DAV:',getcontentlanguage}, % not supported in GET 602 % so omitted here as well 603 {'DAV:',getcontentlength}, 604 {'DAV:',getcontenttype}, 605 {'DAV:',getetag}, 606 {'DAV:',getlastmodified}, 607 {'DAV:',lockdiscovery}, % class 2 compliancy 608 %%{'DAV:','quota-avialable-bytes'} % RFC4331 609 %{'DAV:','quota-used-bytes'} % RFC4331 610 {'DAV:',resourcetype}, 611 {'DAV:',supportedlock} % class 2 compliancy 612 ], 613 %% properties depending on file type 614 P2 = case F#file_info.type of 615 directory when C==windows -> 616 [ 617 {'DAV:',childcount} % Microsoft extension 618 ]; 619 %% The executable property is only shown for regular files 620 regular -> 621 [ 622 {'http://apache.org/dav/props/',executable} % Apache extension 623 ]; 624 _ -> [ 625 ] 626 end, 627 %% compatibility properties 628 P3 = case C of 629 microsoft -> [ 630 %%{'DAV:',iscollection}, 631 {'DAV:',isfolder}, 632 {'DAV:',ishidden} 633 %%{'DAV:',isreadonly}, 634 %%{'DAV:',isroot}, 635 %%{'DAV:',name}, 636 ]; 637 _ -> [ 638 {'DAV:',displayname} 639 ] 640 end, 641 P1++P2++P3. 642 643prop_get({'http://yaws.hyber.org/',access},_A,R) -> 644 F = R#resource.info, 645 A = F#file_info.access, 646 P = {access, [{xmlns,'http://yaws.hyber.org/'}], [atom_to_list(A)]}, 647 {200, P}; 648prop_get({'DAV:',childcount},A,_R) -> 649 Path=davpath(A), 650 L = case file:list_dir(Path) of 651 {ok, Files} -> length(Files); 652 _ -> 0 653 end, 654 P = {'D:childcount', [], [integer_to_list(L)]}, 655 {200, P}; 656prop_get({'DAV:',creationdate},_A,R) -> 657 F = R#resource.info, 658 D = F#file_info.ctime, 659 T = yaws:local_time_as_gmt_string(D), 660 P = {'D:creationdate', [], [lists:flatten(T)]}, 661 {200, P}; 662prop_get({'DAV:',displayname},_A,R) -> 663 case get(compatibility) of 664 microsoft -> 665 {404,{'D:displayname',[],[]}}; 666 _ -> 667 Name = filename:basename(R#resource.name), 668 Xml = #xmlText{type=cdata,value=Name}, 669 P = {'D:displayname', [], [Xml]}, 670 {200, P} 671 end; 672prop_get({'http://apache.org/dav/props/',executable},_A,R) -> 673 F = R#resource.info, 674 case F#file_info.type of 675 directory -> {404,{executable, 676 [{'xmlns',"http://apache.org/dav/props/"}], []}}; 677 _ -> 678 %% TODO check on extension for Windows? 679 X = case F of 680 #file_info{mode=Mode} when Mode band 8#111 =/= 0 -> "T"; 681 _ -> "F" 682 end, 683 {200, {executable, [{'xmlns',"http://apache.org/dav/props/"}], X}} 684 end; 685prop_get({'DAV:',getcontentlanguage},_A,_R) -> 686 P = {'D:getcontentlanguage', [], []}, 687 {200, P}; 688prop_get({'DAV:',getcontentlength},_A,R) -> 689 F = R#resource.info, 690 P = {'D:getcontentlength', [], [integer_to_list(F#file_info.size)]}, 691 {200, P}; 692prop_get({'DAV:',getcontenttype},_A,R) -> 693 F = R#resource.info, 694 Mediatype = case F#file_info.type of 695 directory -> 696 "httpd/unix-directory"; 697 %%"text/html"; 698 %% this should represent the mediatype of a GET on a collection 699 _ -> 700 Name = R#resource.name, 701 Ext = filename:extension(Name), 702 Ext1 = case Ext of 703 [] -> ""; 704 _ -> tl(Ext) 705 end, 706 {_Kind,Mimetype} = mime_types:t(Ext1), 707 Mimetype 708 end, 709 P = {'D:getcontenttype', [], [Mediatype]}, 710 {200, P}; 711prop_get({'DAV:',getetag},_A,R) -> 712 F = R#resource.info, 713 E = yaws:make_etag(F), 714 P = {'D:getetag', [], [E]}, 715 {200, P}; 716prop_get({'DAV:',getlastmodified},_A,R) -> 717 F = R#resource.info, 718 D = F#file_info.mtime, 719 T = yaws:local_time_as_gmt_string(D), 720 X = lists:flatten(T), 721 C = get(compatibility), 722 P = case C of 723 microsoft -> 724 {'getlastmodified', 725 [{'xmlns:b', 726 "urn:uuid:c2f41010-65b3-11d1-a29f-00aa00c14882/"}, 727 {'b:dt',"dateTime.rfc1123"}],[X]}; 728 _ -> {'D:getlastmodified',[],[X]} 729 end, 730 {200, P}; 731prop_get({'DAV:',isfolder},_A,R) -> 732 F = R#resource.info, 733 D = case F#file_info.type of 734 directory -> "1"; 735 _ -> "0" 736 end, 737 P = {'D:isfolder', [], [D]}, 738 {200, P}; 739prop_get({'DAV:',ishidden},_A,R) -> 740 N = filename:basename(R#resource.name), 741 H = case N of 742 "."++_Rest -> "1"; % dotted file 743 _ -> "0" 744 end, 745 P = {'D:ishidden', [], [H]}, 746 {200, P}; 747prop_get({'DAV:',resourcetype},_A,R) -> 748 F = R#resource.info, 749 P = case F#file_info.type of 750 directory -> {'D:resourcetype', [], [{'D:collection',[],[]}]}; 751 _ -> {'D:resourcetype', [], []} 752 end, 753 {200, P}; 754prop_get({'DAV:',lockdiscovery},A,_R) -> 755 Path = davpath(A), 756 Locks = yaws_runmod_lock:discover(Path), 757 case Locks of 758 [] -> 759 {404,{'D:lockdiscovery',[],[]}}; 760 _ -> 761 ActiveLocks = 762 [{'D:activelock',[], 763 [{'D:lockscope',[],[prop_get_format(scope,Lock#lock.scope)]}, 764 {'D:locktype',[],[prop_get_format(type,Lock#lock.type)]}, 765 {'D:depth',[],[prop_get_format(depth,Lock#lock.depth)]}, 766 {'D:owner',[],[prop_get_format(owner,Lock#lock.owner)]}, 767 {'D:timeout',[],[prop_get_format(timeout,Lock#lock.timeout)]}, 768 {'D:locktoken',[],[prop_get_format(locktoken,Lock#lock.id)]}, 769 {'D:lockroot',[],[prop_get_format(lockroot,Lock#lock.path)]} 770 ]} 771 || Lock <- Locks ], 772 {200, {'D:lockdiscovery',[],ActiveLocks}} 773 end; 774prop_get({'DAV:',supportedlock},_A,_R) -> 775 P = {'D:supportedlock',[],[ 776 {'D:lockentry',[],[ 777 {'D:lockscope',[],[{'D:exclusive',[],[]}]}, 778 {'D:locktype',[],[{'D:write',[],[]}]} 779 ]}, 780 {'D:lockentry',[],[ 781 {'D:lockscope',[],[{'D:shared',[],[]}]}, 782 {'D:locktype',[],[{'D:write',[],[]}]} 783 ]} 784 ]}, 785 {200, P}; 786prop_get({'',_P},_A,_R) -> 787 throw(400); 788prop_get({NS,P},_A,_R) -> 789 {404,{P,[{'xmlns',NS}],[]}}. 790 791 792prop_set({'DAV:',creationdate},A,_R,V) -> 793 Path=davpath(A), 794 P = {'D:creationdate', [], []}, 795 case file:read_file_info(Path) of 796 {ok,F0} -> 797 T = yaws:stringdate_to_datetime(V), 798 F1 = F0#file_info{ctime=T}, 799 case file:write_file_info(Path,F1) of 800 ok -> 801 {200, P}; 802 {error,_} -> 803 {409, P} 804 end; 805 {error,_} -> 806 {409, P} 807 end; 808prop_set({'DAV:',getlastmodified},A,_R,V) -> 809 Path=davpath(A), 810 P = {'D:getlastmodified', [], []}, 811 case file:read_file_info(Path) of 812 {ok,F0} -> 813 T = yaws:stringdate_to_datetime(V), 814 F1 = F0#file_info{mtime=T}, 815 case file:write_file_info(Path,F1) of 816 ok -> 817 {200, P}; 818 {error,_} -> 819 {409, P} 820 end; 821 {error,_} -> 822 {409, P} 823 end; 824%%prop_set({'http://apache.org/dav/props/',executable},_A,R,_V) -> 825%% {501,{P,[{'xmlns',NS}],[]}}; % Not yet implemented 826prop_set({'DAV:',getetag},_A,_R,_V) -> 827 {403,{'D:getetag',[],[{'cannot-modify-protected-property',[],[]}]}}; 828prop_set({'DAV:',lockdiscovery},_A,_R,_V) -> 829 {403,{'D:lockdiscovery',[],[{'cannot-modify-protected-property',[],[]}]}}; 830prop_set({'DAV:',resourcetype},_A,_R,_V) -> 831 {403,{'D:resourcetype',[],[{'cannot-modify-protected-property',[],[]}]}}; 832prop_set({NS,P},_A,_R,_V) -> 833 {404,{P,[{'xmlns',NS}],[]}}. 834 835 836prop_remove({P,NS},_A,_R) -> 837 {403,{P,[{'xmlns',NS}],[]}}. 838 839 840prop_get_format(type,write) -> 841 {'D:write',[],[]}; 842prop_get_format(scope,exclusive) -> 843 {'D:exclusive',[],[]}; 844prop_get_format(scope,_) -> 845 {'D:shared',[],[]}; 846prop_get_format(depth,infinity) -> 847 "infinity"; 848prop_get_format(depth,Depth) -> 849 integer_to_list(Depth); 850prop_get_format(timeout,Timeout) -> 851 lists:flatten(io_lib:format("Second-~p",[Timeout])); 852prop_get_format(locktoken,Id) -> 853 {'D:href',[],["opaquelocktoken:"++Id]}; 854prop_get_format(lockroot,Ref) -> 855 {'D:href',[],[Ref]}; 856prop_get_format(owner,Owner) -> 857 Owner; 858prop_get_format(_Something,_) -> 859 ?DEBUG(" did not expect ~p here ~n",[_Something]), 860 throw(500). 861 862 863%% -------------------------------------------------------- 864%% Resource mapping 865%% 866 867davname(A) -> 868 A#arg.server_path. 869 870davpath(A) -> 871 filename:join(A#arg.docroot,["./",A#arg.server_path]). 872 873%% davresource0/1 - get resources with depth 0 874davresource0(A) -> 875 Name = davname(A), 876 Path = davpath(A), 877 case file:read_file_info(Path) of 878 {ok, F} when (F#file_info.type == directory) or 879 (F#file_info.type == regular) -> 880 #resource{ name = Name, info = F}; 881 {error,_} -> throw(404) 882 end. 883%% davresource1/1 - get additional resources for depth 1 884davresource1(A) -> 885 Coll = davname(A), 886 Path = davpath(A), 887 case file:read_file_info(Path) of 888 {ok, Dir} when Dir#file_info.type == directory -> 889 {ok, L} = file:list_dir(Path), 890 davresource1(A,Path,Coll,L,[]); 891 {ok, _Else} -> 892 [] 893 end. 894davresource1(_A,_Path,_Coll,[],Result) -> 895 Result; 896davresource1(_A,Path,Coll,[Name|Rest],Result) -> 897 File = filename:join(Path,Name), 898 Ref = filename:join(Coll,Name), 899 {ok, Info} = file:read_file_info(File), 900 if 901 (Info#file_info.type == regular) or 902 (Info#file_info.type == directory) -> 903 Resource = #resource {name = Ref, info = Info}, 904 davresource1(_A,Path,Coll,Rest,[Resource|Result]); 905 true -> 906 davresource1(_A,Path,Coll,Rest,Result) 907 end. 908 909 910%% -------------------------------------------------------- 911%% Parse additional HTTP headers 912%% 913 914h_litmus(A) -> 915 Hs = (A#arg.headers)#headers.other, 916 case lists:keysearch("X-Litmus", 3, Hs) of 917 {value, {_,_,"X-Litmus",_,_Test}} -> 918 ?DEBUG("~s - ",[_Test]); 919 _ -> 920 ok 921 end. 922 923h_depth(A) -> 924 Hs = (A#arg.headers)#headers.other, 925 case lists:keysearch("Depth", 3, Hs) of 926 {value, {_,_,"Depth",_,Depth}} -> 927 h_depth_interpret(Depth); 928 _ -> 929 infinity 930 end. 931h_depth_interpret("infinity") -> infinity; 932h_depth_interpret("1") -> 1; 933h_depth_interpret(_) -> 0. 934 935h_destination(A) -> 936 Hs = (A#arg.headers)#headers.other, 937 case lists:keysearch("Destination", 3, Hs) of 938 {value, {http_header,_,_,_,Dest}} -> 939 Url = yaws_api:parse_url(Dest), 940 {Path,_} = yaws_api:url_decode_q_split(Url#url.path), 941 ?DEBUG(" TO ~p",[Path]), 942 filename:join(A#arg.docroot,["./",Path]); 943 _ -> 944 throw(501) 945 end. 946 947h_overwrite(A) -> 948 Hs = (A#arg.headers)#headers.other, 949 case lists:keysearch("Overwrite", 3, Hs) of 950 {value, {http_header, _ , _, _, "T"}} -> 951 true; 952 _ -> 953 false 954 end. 955 956h_timeout(A) -> 957 Hs = (A#arg.headers)#headers.other, 958 case lists:keysearch("Timeout", 3, Hs) of 959 {value, {_,_,"Timeout",_,T}} -> 960 case T of 961 "Second-"++TimeoutVal -> 962 Val = case catch list_to_integer(TimeoutVal) of 963 I when is_integer(I) -> I; 964 _ -> ?LOCK_LIFETIME 965 end, 966 erlang:min(Val,?LOCK_LIFETIME); 967 _ -> ?LOCK_LIFETIME 968 end; 969 _ -> 970 ?LOCK_LIFETIME 971 end. 972 973h_locktoken(A) -> 974 Hs = (A#arg.headers)#headers.other, 975 C = get(compatibility), 976 case lists:keysearch("Lock-Token", 3, Hs) of 977 {value, {_,_,"Lock-Token",_,URL}} -> 978 case URL of 979 %%"<opaquelocktoken:"++Token -> string:left(Token,36); 980 "<opaquelocktoken:"++Token -> 981 T = parse_locktoken(Token), 982 check_locktoken_format(T), 983 T; 984 "opaquelocktoken:"++Token when C==microsoft -> Token; 985 _ -> URL 986 end; 987 _ -> 988 undefined 989 end. 990parse_locktoken([]) -> 991 []; 992parse_locktoken([H|_T]) when H==62 -> 993 []; 994parse_locktoken([H|T]) -> 995 [H|parse_locktoken(T)]. 996 997check_locktoken_format("DAV:no-lock") -> 998 ok; 999check_locktoken_format(Token) when length(Token)==36 -> 1000 ok; 1001check_locktoken_format(_Token) -> 1002 throw(423). 1003 1004%%h_if_match(A,Path) -> 1005%% Hs = (A#arg.headers)#headers.other, 1006%% case lists:keysearch("If-Match", 3, Hs) of 1007%% {value, {_,_,"If-Match",_,Tag}} -> 1008%% F = file:read_file_info(Path), 1009%% case yaws:make_etag(F) of 1010%% Tag -> ok; 1011%% _ -> throw(412) 1012%% end; 1013%% _ -> 1014%% ok 1015%% end. 1016 1017h_if_refresh(A,Path) -> 1018 ?DEBUG(" If(~p)",[Path]), 1019 _Locks = yaws_runmod_lock:discover(Path), 1020 Hs = (A#arg.headers)#headers.other, 1021 case lists:keysearch("If", 3, Hs) of 1022 {value, {_,_,"If",_,If}} -> 1023 List = if_parse(If,untagged), 1024 %%?DEBUG(" ~p",[List]), 1025 case List of 1026 [{_Resource,[{true,state,Locktoken}]}] -> Locktoken; 1027 _ -> throw(412) 1028 end; 1029 _ -> 1030 undefined 1031 end. 1032 1033h_if(A,Path) -> 1034 ?DEBUG(" If(~p)",[Path]), 1035 Locks = yaws_runmod_lock:discover(Path), 1036 Hs = (A#arg.headers)#headers.other, 1037 {_L,I} = case lists:keysearch("If", 3, Hs) of 1038 {value, {_,_,"If",_,If}} -> 1039 List = if_parse(If,untagged), 1040 Value = if_eval(A,Locks,List), 1041 {List,Value}; 1042 _ -> 1043 {[],undefined} 1044 end, 1045 ?DEBUG(" -> ~p (~p)",[I,length(Locks)]), 1046 ?DEBUG(" If-header ~p (~p) evaluated to ~p~n",[_L,length(Locks),I]), 1047 case I of 1048 undefined when length(Locks)>0 -> throw(423); 1049 %%false when length(Locks)>0 -> throw(412); 1050 false -> throw(412); 1051 _ -> ok 1052 end. 1053 1054if_parse([],_Resource) -> 1055 []; 1056if_parse(Line,Resource) when hd(Line)==32 -> 1057 if_parse(tl(Line),Resource); 1058if_parse(Line,untagged) when hd(Line)==60 -> % < 1059 {Url,Rest} = if_parse_token(tl(Line),""), 1060 if_parse(Rest,Url); 1061if_parse(Line,Resource) when hd(Line)==40 -> % ( 1062 {Condition,Rest} = if_parse_condition(tl(Line),[],true), 1063 [{Resource,Condition}|if_parse(Rest,untagged)]. 1064 1065if_parse_condition(Line,List,_Bool) when hd(Line)==41 -> % ) 1066 {List,tl(Line)}; 1067if_parse_condition(Line,List,Bool) when hd(Line)==32 -> % whitespace 1068 if_parse_condition(tl(Line),List,Bool); 1069if_parse_condition("Not"++Line,List,_Bool) -> % negate 1070 if_parse_condition(tl(Line),List,false); 1071if_parse_condition(Line,List,Bool) when hd(Line)==60 -> % < 1072 {Token,Rest} = if_parse_token(tl(Line),""), 1073 if_parse_condition(Rest,[{Bool,state,Token}|List],true); 1074if_parse_condition(Line,List,Bool) when hd(Line)==91 -> % [ 1075 {Etag,Rest} = if_parse_etag(tl(Line),""), 1076 if_parse_condition(Rest,[{Bool,etag,Etag}|List],true). 1077 1078if_parse_token(Line,Buffer) when hd(Line)==62 -> % > 1079 Uri = lists:reverse(Buffer), 1080 Token1 = case Uri of 1081 "opaquelocktoken:"++Token -> 1082 check_locktoken_format(Token), 1083 Token; 1084 _ -> Uri 1085 end, 1086 {Token1,tl(Line)}; 1087if_parse_token([H|T],Buffer) -> 1088 if_parse_token(T,[H|Buffer]). 1089 1090if_parse_etag(Line,Buffer) when hd(Line)==93 -> % ] 1091 {lists:reverse(Buffer),tl(Line)}; 1092if_parse_etag([H|T],Buffer) -> 1093 if_parse_etag(T,[H|Buffer]). 1094 1095%% if_eval(A,RequestPath,Conditions) 1096if_eval(_A,_Locks,[]) -> 1097 false; 1098if_eval(A,Locks,[{Resource,AndList}|More]) -> 1099 Target = case Resource of 1100 untagged -> davpath(A); 1101 _ -> 1102 Url = yaws_api:parse_url(Resource), 1103 filename:join(A#arg.docroot,["./",Url#url.path]) 1104 end, 1105 if_eval_condition(AndList,A,Target,Locks) orelse if_eval(A,Locks,More). 1106 1107if_eval_condition(AndList,A,Target,Locks) -> 1108 if_eval_condition(AndList,true,false,A,Target,Locks). 1109 1110if_eval_condition([],Result,Valid,_A,_Target,_Locks) -> 1111 Result and Valid; 1112if_eval_condition([{false,Kind,Ref}|T],Result,Valid,A,Target,Locks) -> 1113 not if_eval_condition([{true,Kind,Ref}|T],Result,Valid,A,Target,Locks); 1114if_eval_condition([{true,state,Ref}|T],_Result,_Valid,A,Target,Locks) -> 1115 Result1 = if_eval_locktoken(Target,Ref,Locks), 1116 Valid1 = true, 1117 Result1 andalso if_eval_condition(T,Result1,Valid1,A,Target,Locks); 1118if_eval_condition([{true,etag,Ref}|T],_Result,Valid,A,Target,Locks) -> 1119 {ok, F} = file:read_file_info(filename:join(A#arg.docroot,Target)), 1120 E = yaws:make_etag(F), 1121 Result1 = (E==Ref), 1122 Valid1 = Valid, 1123 Result1 andalso if_eval_condition(T,Result1,Valid1,A,Target,Locks). 1124 1125%% if_eval_locktoken(Target,Token,Locktokens) -> true|false 1126if_eval_locktoken(_Target,_Token,[]) -> 1127 false; 1128%%if_eval_locktoken(_Target,"DAV:no-lock",[]) -> 1129%% true; 1130if_eval_locktoken(Target,Token,[H|T]) -> 1131 ((H#lock.path == Target) and (H#lock.id == Token)) 1132 orelse if_eval_locktoken(Target,Token,T). 1133 1134 1135%% -------------------------------------------------------- 1136%% Parsing of XML elements (RFC4918) 1137%% 1138%% activelock 1139-define(IS_ALLPROP(X), #xmlElement{expanded_name = {'DAV:',allprop}} = X). 1140%% collection 1141%% depth 1142%% error 1143-define(IS_EXCLUSIVE(X), #xmlElement{expanded_name = {'DAV:',exclusive}} = X). 1144-define(IS_HREF(X), #xmlElement{expanded_name = {'DAV:',href}} = X). 1145%% include % TODO: add this tag 1146%% location 1147%% lockentry 1148-define(IS_LOCKINFO(X), #xmlElement{expanded_name = {'DAV:',lockinfo}} = X). 1149%% lockroot 1150-define(IS_LOCKSCOPE(X), #xmlElement{expanded_name = {'DAV:',lockscope}} = X). 1151%% locktoken 1152-define(IS_LOCKTYPE(X), #xmlElement{expanded_name = {'DAV:',locktype}} = X). 1153%% multistatus 1154-define(IS_OWNER(X), #xmlElement{expanded_name = {'DAV:',owner}} = X). 1155-define(IS_PROP(X), #xmlElement{expanded_name = {'DAV:',prop}} = X). 1156-define(IS_PROPERTYUPDATE(X), 1157 #xmlElement{expanded_name = {'DAV:',propertyupdate}} = X). 1158-define(IS_PROPFIND(X), #xmlElement{expanded_name = {'DAV:',propfind}} = X). 1159-define(IS_PROPNAME(X), #xmlElement{expanded_name = {'DAV:',propname}} = X). 1160%% propstat 1161-define(IS_REMOVE(X), #xmlElement{expanded_name = {'DAV:',remove}} = X). 1162%% response 1163%% responsedescription 1164-define(IS_SET(X), #xmlElement{expanded_name = {'DAV:',set}} = X). 1165-define(IS_SHARED(X), #xmlElement{expanded_name = {'DAV:',shared}} = X). 1166%% status 1167%% timeout 1168-define(IS_WRITE(X), #xmlElement{expanded_name = {'DAV:',write}} = X). 1169 1170-define(CONTENT(X), X#xmlElement.content). 1171 1172%% Parameter is always list 1173parse_propfind([]) -> [allprop]; % RFC4918: no body then allprop, is [] no body? 1174parse_propfind(L) -> 1175 case catch xmerl_scan:string(L, [{namespace_conformant, true}]) of 1176 {?IS_PROPFIND(X),_} -> 1177 parse_propfind(?CONTENT(X),[]); 1178 _Z -> 1179 throw(400) 1180 end. 1181parse_propfind([?IS_PROPNAME(_H)|_T], _R) -> 1182 [propname]; 1183parse_propfind([?IS_ALLPROP(_H)|_T], _R) -> 1184 [allprop]; 1185parse_propfind([?IS_PROP(H)|_T], _R) when length(?CONTENT(H))==0 -> 1186 [allprop]; % NetDrive uses empty <prop> element instead of <allprop> 1187parse_propfind([?IS_PROP(H)|T], _R) -> 1188 Props = parse_prop(?CONTENT(H)), 1189 parse_propfind(T, Props); 1190parse_propfind([_H|T], R) -> 1191 parse_propfind(T, R); 1192parse_propfind([], R) -> 1193 R. 1194 1195parse_proppatch(L) -> 1196 case catch xmerl_scan:string(L, [{namespace_conformant, true}]) of 1197 {?IS_PROPERTYUPDATE(X),_} -> 1198 parse_proppatch(?CONTENT(X),[]); 1199 _Z -> 1200 throw(400) 1201 end. 1202parse_proppatch([?IS_SET(H)|T],R) -> 1203 Props = parse_setremove(?CONTENT(H)), 1204 parse_proppatch(T,[{set,Props}|R]); 1205parse_proppatch([?IS_REMOVE(H)|T],R) -> 1206 Props = parse_setremove(?CONTENT(H)), 1207 parse_proppatch(T,[{remove,Props}|R]); 1208parse_proppatch([_H|T], R) -> 1209 parse_proppatch(T, R); 1210parse_proppatch([],R) -> 1211 lists:reverse(R). % MUST proces in document order 1212 1213parse_setremove([?IS_PROP(X)]) -> 1214 parse_prop(?CONTENT(X)). 1215 1216parse_prop(L) -> 1217 parse_prop(L, []). 1218 1219parse_prop([H|T],L) -> 1220 case H of 1221 H when is_record(H,xmlElement) -> 1222 %% check on supported namespaces: 1223 %% - http://www.w3.org/TR/RC-xml-names#dt-prefix 1224 %% - although strict, not very forgiving towards clients 1225 %%NS = H#xmlElement.namespace, 1226 %%case NS#xmlNamespace.default of 1227 %% "" -> 1228 %% throw(400); 1229 %% _ -> ok 1230 %%end, 1231 Value = case H#xmlElement.content of 1232 [C] when is_record(C,xmlText) -> C#xmlText.value; 1233 _ -> "" 1234 end, 1235 parse_prop(T,[{H#xmlElement.expanded_name,Value}|L]); 1236 _ -> 1237 parse_prop(T,L) 1238 end; 1239parse_prop([], L) -> 1240 L. 1241 1242parse_lockinfo([]) -> 1243 #lock{}; 1244parse_lockinfo(L) -> 1245 case catch xmerl_scan:string(L, [{namespace_conformant, true}]) of 1246 {?IS_LOCKINFO(X),_} -> 1247 parse_lockinfo(?CONTENT(X),#lock{}); 1248 _Z -> 1249 throw(400) 1250 end. 1251parse_lockinfo([?IS_LOCKSCOPE(H)|T], D) -> 1252 X = parse_lockscope(?CONTENT(H)), 1253 parse_lockinfo(T,D#lock{scope=X}); 1254parse_lockinfo([?IS_LOCKTYPE(H)|T], D) -> 1255 X = parse_locktype(?CONTENT(H)), 1256 parse_lockinfo(T,D#lock{type=X}); 1257parse_lockinfo([?IS_OWNER(H)|T], D) -> 1258 X = parse_owner(?CONTENT(H)), 1259 parse_lockinfo(T,D#lock{owner=X}); 1260parse_lockinfo([_H|T],D) -> 1261 parse_lockinfo(T,D); % skip spaces and comments, etc. 1262parse_lockinfo([], D) -> 1263 D. 1264 1265parse_lockscope([?IS_EXCLUSIVE(_H)|_T]) -> 1266 exclusive; 1267parse_lockscope([?IS_SHARED(_H)|_T]) -> 1268 shared; 1269parse_lockscope(_X) -> 1270 throw(400). 1271 1272parse_locktype([?IS_WRITE(_H)|_T]) -> 1273 write; 1274parse_locktype(_) -> 1275 throw(400). 1276 1277parse_owner(X) -> 1278 Xml = xmerl:export_simple_content(X,xmerl_xml), 1279 lists:flatten(Xml). 1280 1281%% -------------------------------------------------------- 1282%% Status output 1283%% 1284 1285status(Status) -> 1286 status(Status,[],[]). 1287status(Status,Response) -> 1288 status(Status,[],Response). 1289status(Status,Headers,{xml,Response}) -> 1290 Xml = xml_expand(Response), 1291 status(Status,Headers,{content, "application/xml; charset=\"utf-8\"", Xml}); 1292status(Status,Headers,Response) -> 1293 ?DEBUG(" -> ~p~n",[Status]), 1294 H = case get(compatibility) of 1295 microsoft -> [{header,{"MS-Author-Via","DAV"}}|Headers]; 1296 _ -> Headers 1297 end, 1298 [{status, Status},{header,{"DAV","1, 2, 3"}}|H] ++ [Response]. 1299 1300xml_expand(L) -> 1301 xml_expand(L, "utf-8"). 1302xml_expand(L, Cset) -> 1303 Prolog = ["<?xml version=\"1.0\" encoding=\"",Cset,"\" ?>"], 1304 %%Xml = xmerl:export_simple(L,xmerl_xml,[{prolog,Prolog}]), 1305 %% MS requires \r\n at end of every XML response 1306 case get(compatibility) of 1307 microsoft -> 1308 [Prolog,yaws_appmod_dav:export(L),"\r\n"]; 1309 _ -> 1310 [Prolog,yaws_appmod_dav:export(L)] 1311 end. 1312 1313%% -------------------------------------------------------- 1314%% XML output (xmlerl_xml does not support CDATA) 1315%% 1316 1317export([]) -> 1318 []; 1319export([#xmlComment{}|T]) -> % for now I skip comments 1320 export(T); 1321export([#xmlText{type=text, value=Text}|T]) -> 1322 [export_text(Text),export(T)]; 1323export([#xmlText{type=cdata, value=Text}|T]) -> 1324 ["<![CDATA[",Text,"]]>",export(T)]; 1325export([#xmlElement{name=Name,attributes=Attrs,content=Content}|T]) -> 1326 export([{Name,Attrs,Content}|T]); 1327export([{Name,Attrs,Content}|T]) when is_atom(Name)-> 1328 Tag = atom_to_list(Name), 1329 export([{Tag,Attrs,Content}|T]); 1330export([{Tag,Attrs,[]}|T]) when is_list(Tag)-> 1331 ["<",Tag,export_attrs(Attrs)," />",export(T)]; 1332export([{Tag,Attrs,Content}|T]) when is_list(Tag)-> 1333 ["<",Tag,export_attrs(Attrs),">", 1334 export_content(Content),"</",Tag,">",export(T)]. 1335 1336export_content([]) -> 1337 ""; 1338export_content([H|T]) when is_tuple(H) -> % tuples are XML records 1339 export([H|T]); 1340export_content([H]) when is_number(H) -> 1341 integer_to_list(H); 1342export_content([H]) when is_atom(H) -> 1343 atom_to_list(H); 1344export_content(L) -> 1345 L. 1346 1347export_attrs([]) -> 1348 []; 1349export_attrs([{Name,Value}|T]) -> 1350 [" ",export_id(Name),"=\"",export_id(Value),"\"",export_attrs(T)]; 1351export_attrs([Attr|T]) -> 1352 [" \"",export_id(Attr),"\"",export_attrs(T)]. 1353 1354export_id(Id) when is_atom(Id) -> 1355 atom_to_list(Id); 1356export_id(Id) when is_number(Id) -> 1357 integer_to_list(Id); 1358export_id(Id) when is_list(Id) -> 1359 Id. 1360 1361 1362