← Back to branch summary

~ubuntu-branches/ubuntu/utopic/castle-game-engine/utopic

« back to all changes in this revision

Viewing changes to src/net/castleurlutils.pas

  • Committer: Package Import Robot
  • Author(s): Abou Al Montacir
  • Date: 2013-04-27 18:06:40 UTC
  • Revision ID: package-import@ubuntu.com-20130427180640-eink4nmwzuivez1c
Tags: upstream-4.0.1
Import upstream version 4.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/net/castleurlutils.pas
 
1
{
 
2
  Copyright 2007-2013 Michalis Kamburelis.
 
3
 
 
4
  This file is part of "Castle Game Engine".
 
5
 
 
6
  "Castle Game Engine" is free software; see the file COPYING.txt,
 
7
  included in this distribution, for details about the copyright.
 
8
 
 
9
  "Castle Game Engine" is distributed in the hope that it will be useful,
 
10
  but WITHOUT ANY WARRANTY; without even the implied warranty of
 
11
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
12
 
 
13
  ----------------------------------------------------------------------------
 
14
}
 
15
 
 
16
{ URL utilities. Not much for now, will be much more when handling URLs
 
17
  in VRML engine will be really implemented. }
 
18
unit CastleURLUtils;
 
19
 
 
20
interface
 
21
 
 
22
{ Extracts #anchor from URL. On input, URL contains full URL.
 
23
  On output, Anchor is removed from URL and saved in Anchor.
 
24
  If no #anchor existed, Anchor is set to ''. }
 
25
procedure URLExtractAnchor(var URL: string; out Anchor: string);
 
26
 
 
27
{ Replace all sequences like %xx with their actual 8-bit characters.
 
28
 
 
29
  The intention is that this is similar to PHP function with the same name.
 
30
 
 
31
  To account for badly encoded strings, invalid encoded URLs do not
 
32
  raise an error --- they are only reported to OnWarning.
 
33
  So you can simply ignore them, or write a warning about them for user.
 
34
  This is done because often you will use this with
 
35
  URLs provided by the user, read from some file etc., so you can't be sure
 
36
  whether they are correctly encoded, and raising error unconditionally
 
37
  is not OK. (Considering the number of bad HTML pages on WWW.)
 
38
 
 
39
  The cases of badly encoded strings are:
 
40
 
 
41
  @unorderedList(
 
42
    @item("%xx" sequence ends unexpectedly at the end of the string.
 
43
      That is, string ends with "%" or "%x". In this case we simply
 
44
      keep "%" or "%x" in resulting string.)
 
45
 
 
46
    @item("xx" in "%xx" sequence is not a valid hexadecimal number.
 
47
      In this case we also simply keep "%xx" in resulting string.)
 
48
  )
 
49
}
 
50
function RawUrlDecode(const S: string): string;
 
51
 
 
52
function UrlProtocol(const S: string): string;
 
53
 
 
54
{ Check does URL contain given Protocol.
 
55
  This is equivalent to checking UrlProtocol(S) = Protocol, ignoring case,
 
56
  although may be a little faster. Given Protocol string cannot contain
 
57
  ":" character. }
 
58
function UrlProtocolIs(const S: string; const Protocol: string; out Colon: Integer): boolean;
 
59
 
 
60
function UrlDeleteProtocol(const S: string): string;
 
61
 
 
62
{ Combine base URL with relative, just like CombinePaths does for file paths.
 
63
 
 
64
  TODO: this is a dummy implementation for now, that basically calls
 
65
  CombinePaths, however it allows the Base or Relative to start with 'file://'
 
66
  prefix (but result will not contain this prefix).
 
67
  This allows most places in our engine (that in the future should deal with
 
68
  URLs) for now just work with local file paths. }
 
69
function CombineUrls(Base, Relative: string): string;
 
70
 
 
71
implementation
 
72
 
 
73
uses SysUtils, CastleStringUtils, CastleWarnings, CastleFilesUtils;
 
74
 
 
75
procedure URLExtractAnchor(var URL: string; out Anchor: string);
 
76
var
 
77
  HashPos: Integer;
 
78
begin
 
79
  HashPos := BackPos('#', URL);
 
80
  if HashPos <> 0 then
 
81
  begin
 
82
    Anchor := SEnding(URL, HashPos + 1);
 
83
    SetLength(URL, HashPos - 1);
 
84
  end;
 
85
end;
 
86
 
 
87
function RawUrlDecode(const S: string): string;
 
88
 
 
89
  { Assume Position <= Length(S).
 
90
    Check is S[Positon] is a start of %xx sequence:
 
91
    - if not, exit false
 
92
    - if yes, but %xx is invalid, report OnWarning and exit false
 
93
    - if yes and %xx is valid, set DecodedChar and exit true }
 
94
  function ValidSequence(const S: string; Position: Integer;
 
95
    out DecodedChar: char): boolean;
 
96
  const
 
97
    ValidHexaChars = ['a'..'f', 'A'..'F', '0'..'9'];
 
98
 
 
99
    { Assume C is valid hex digit, return it's value (in 0..15 range). }
 
100
    function HexDigit(const C: char): Byte;
 
101
    begin
 
102
      if C in ['0'..'9'] then
 
103
        Result := Ord(C) - Ord('0') else
 
104
      if C in ['a'..'f'] then
 
105
        Result := 10 + Ord(C) - Ord('a') else
 
106
      if C in ['A'..'F'] then
 
107
        Result := 10 + Ord(C) - Ord('A');
 
108
    end;
 
109
 
 
110
  begin
 
111
    Result := S[Position] = '%';
 
112
    if Result then
 
113
    begin
 
114
      if Position + 2 > Length(S) then
 
115
      begin
 
116
        OnWarning(wtMajor, 'URL', Format(
 
117
          'URL "%s" incorrectly encoded, %%xx sequence ends unexpectedly', [S]));
 
118
        Exit(false);
 
119
      end;
 
120
 
 
121
      if (not (S[Position + 1] in ValidHexaChars)) or
 
122
         (not (S[Position + 2] in ValidHexaChars)) then
 
123
      begin
 
124
        OnWarning(wtMajor, 'URL', Format(
 
125
          'URL "%s" incorrectly encoded, %s if not a valid hexadecimal number',
 
126
          [S, S[Position + 1] + S[Position + 2]]));
 
127
        Exit(false);
 
128
      end;
 
129
 
 
130
      Byte(DecodedChar) := (HexDigit(S[Position + 1]) shl 4) or
 
131
                            HexDigit(S[Position + 2]);
 
132
    end;
 
133
  end;
 
134
 
 
135
var
 
136
  I, ResultI: Integer;
 
137
  DecodedChar: char;
 
138
begin
 
139
  { Allocate Result string at the beginning, to save time later for
 
140
    memory reallocations. We can do this, since we know that final
 
141
    Result is shorter or equal to S. }
 
142
  SetLength(Result, Length(S));
 
143
 
 
144
  ResultI := 1;
 
145
  I := 1;
 
146
 
 
147
  while I <= Length(S) do
 
148
  begin
 
149
    if ValidSequence(S, I, DecodedChar) then
 
150
    begin
 
151
      Result[ResultI] := DecodedChar;
 
152
      Inc(ResultI);
 
153
      Inc(I, 3);
 
154
    end else
 
155
    begin
 
156
      Result[ResultI] := S[I];
 
157
      Inc(ResultI);
 
158
      Inc(I);
 
159
    end;
 
160
  end;
 
161
 
 
162
  SetLength(Result, ResultI - 1);
 
163
end;
 
164
 
 
165
{ Detect protocol delimiting positions.
 
166
  If returns true, then for sure:
 
167
  - FirstCharacter < Colon
 
168
  - FirstCharacter >= 1
 
169
  - Colon > 1 }
 
170
function UrlProtocolIndex(const S: string; out FirstCharacter, Colon: Integer): boolean;
 
171
var
 
172
  I: Integer;
 
173
begin
 
174
  Result := false;
 
175
  Colon := Pos(':', S);
 
176
  if Colon <> 0 then
 
177
  begin
 
178
    (* Skip beginning whitespace from protocol.
 
179
       This allows us to detect properly "ecmascript:" protocol in
 
180
 
 
181
      Script { url "
 
182
        ecmascript:..." }
 
183
    *)
 
184
    FirstCharacter := 1;
 
185
    while (FirstCharacter < Colon) and (S[FirstCharacter] in WhiteSpaces) do
 
186
      Inc(FirstCharacter);
 
187
 
 
188
    { Protocol cannot contain newline characters.
 
189
      This hardens our check for inline shader source code in url. }
 
190
    for I := FirstCharacter to Colon - 1 do
 
191
      if S[I] in [#10, #13] then Exit;
 
192
 
 
193
    Result := FirstCharacter < Colon;
 
194
  end;
 
195
end;
 
196
 
 
197
function UrlProtocol(const S: string): string;
 
198
var
 
199
  FirstCharacter, Colon: Integer;
 
200
begin
 
201
  if UrlProtocolIndex(S, FirstCharacter, Colon) then
 
202
    Result := CopyPos(S, FirstCharacter, Colon - 1) else
 
203
    Result := '';
 
204
end;
 
205
 
 
206
function UrlProtocolIs(const S: string; const Protocol: string; out Colon: Integer): boolean;
 
207
var
 
208
  FirstCharacter, I: Integer;
 
209
begin
 
210
  Result := false;
 
211
  if UrlProtocolIndex(S, FirstCharacter, Colon) and
 
212
     (Colon - FirstCharacter = Length(Protocol)) then
 
213
  begin
 
214
    for I := 1 to Length(Protocol) do
 
215
      if UpCase(Protocol[I]) <> UpCase(S[I - FirstCharacter + 1]) then
 
216
        Exit;
 
217
    Result := true;
 
218
  end;
 
219
end;
 
220
 
 
221
function UrlDeleteProtocol(const S: string): string;
 
222
var
 
223
  FirstCharacter, Colon: Integer;
 
224
begin
 
225
  if UrlProtocolIndex(S, FirstCharacter, Colon) then
 
226
    { Cut off also whitespace before FirstCharacter }
 
227
    Result := SEnding(S, Colon + 1) else
 
228
    Result := S;
 
229
end;
 
230
 
 
231
function CombineUrls(Base, Relative: string): string;
 
232
begin
 
233
  Result := CombinePaths(
 
234
    PrefixRemove('file://', Base, false),
 
235
    PrefixRemove('file://', Relative, false));
 
236
end;
 
237
 
 
238
end.
 
 
b'\\ No newline at end of file'