/[suikacvs]/markup/html/whatpm/Whatpm/CacheManifest.pm
Suika

Diff of /markup/html/whatpm/Whatpm/CacheManifest.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by wakaba, Sat Feb 16 03:47:33 2008 UTC revision 1.8 by wakaba, Sun Aug 31 13:27:33 2008 UTC
# Line 3  use strict; Line 3  use strict;
3  our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};  our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4  require Message::URI::URIReference;  require Message::URI::URIReference;
5    
6  sub parse_byte_string ($$$$$) {  sub parse_byte_string ($$$$;$$) {
7    require Encode;    require Encode;
8    my $s = Encode::decode ('utf-8', $_[1]);    my $s = Encode::decode ('utf-8', $_[1]);
9    return $_[0]->_parse (\$s, $_[2], $_[3], $_[4] || sub {    return $_[0]->_parse (\$s, $_[2], $_[3], $_[4] || sub {
10      my %err = @_;      my %err = @_;
11      warn $err{type}, "\n";      warn $err{type}, "\n";
12    });    }, $_[5]);
13  } # parse_byte_string  } # parse_byte_string
14    
15  sub parse_char_string ($$$$$) {  sub parse_char_string ($$$$;$$) {
16    return $_[0]->_parse (\($_[1]), $_[2], $_[3], $_[4] || sub {    return $_[0]->_parse (\($_[1]), $_[2], $_[3], $_[4] || sub {
17      my %err = @_;      my %err = @_;
18      warn $err{type}, "\n";      warn $err{type}, "\n";
19    });    }, $_[5]);
20  } # parse_char_string  } # parse_char_string
21    
22  sub _parse ($$$$$) {  my $default_error_levels = {
23    #my (undef, $input, $manifest_uri, $base_uri, $onerror) = @_;    must => 'm',
24      info => 'i',
25    };
26    
27    sub _parse ($$$$$$) {
28      #my (undef, $input, $manifest_uri, $base_uri, $onerror, $levels) = @_;
29    
30    ## NOTE: A manifest MUST be labeled as text/cache-manifest.  (This should    ## NOTE: A manifest MUST be labeled as text/cache-manifest.  (This should
31    ## be checked in upper-level).    ## be checked in upper-level).
# Line 34  sub _parse ($$$$$) { Line 39  sub _parse ($$$$$) {
39    my $m_scheme = $m_uri->uri_scheme;    my $m_scheme = $m_uri->uri_scheme;
40    
41    my $onerror = $_[4];    my $onerror = $_[4];
42    my $must_level = 'm';    my $levels = $_[5] || $default_error_levels;
43    my $warn_level = 'w';  
44    my $line_number = 1;    my $line_number = 1;
45    
46    ## Same scheme/host/port    ## Same origin with the manifest's URI
47    my $same_shp = sub {    my $same_origin = sub {
48      ## TODO: implement this algorithm correctly!      ## NOTE: Step numbers in this function corresponds to those in the
49        ## algorithm for determining the origin of a URI specified in HTML5.
50    
51        ## 1. and 2.
52      my $u1 = shift;      my $u1 = shift;
53        #my $m_uri = $m_uri;
54    
55    
56        ## 3.
57        return 0 unless defined $u1->uri_authority;
58        return 0 unless defined $m_uri->uri_authority;
59        ## TODO: In addition, in the case of URIs with non-server-based authority
60        ## it must also return 0.
61            
62        ## 4.
63      unless (lc $u1->uri_scheme eq lc $m_scheme) { ## TODO: case      unless (lc $u1->uri_scheme eq lc $m_scheme) { ## TODO: case
64        return 0;        return 0;
65      }      }
66        ## TODO: Return if $u1->uri_scheme is not a supported scheme.
67        ## NOTE: $m_scheme is always a supported URI scheme, otherwise
68        ## the manifest itself cannot be retrieved.
69    
70      return 0 unless defined $u1->uri_authority;      ## 5., 6., and 7.
     return 0 unless defined $m_uri->uri_authority;  
   
71      return 0 unless $u1->uri_host eq $m_uri->uri_host;      return 0 unless $u1->uri_host eq $m_uri->uri_host;
72        ## TODO: IDNA ToASCII
73    
74        ## 8.
75      return 0 unless $u1->uri_port eq $m_uri->uri_port;      return 0 unless $u1->uri_port eq $m_uri->uri_port;
76        ## TODO: default port
77    
78        ## 9.
79      return 1;      return 1;
80    }; # $same_shp    }; # $same_origin
81    
82    ## Step 5    ## Step 5
83    my $input = $_[1];    my $input = $_[1];
84        
85    ## Step 1: MUST bytes --UTF-8--> characters.    ## Step 1: MUST bytes --UTF-8--> characters.
86    ## NOTE: illegal(s) -> U+FFFD, U+0000 -> U+FFFD    ## NOTE: illegal(s) -> U+FFFD, #U+0000 -> U+FFFD (commented out in r1553).
87    $$input =~ tr/\x00/\x{FFFD}/;    #$$input =~ tr/\x00/\x{FFFD}/;
88    
89    ## Step 2    ## Step 2
90    my $explicit_uris = [];    my $explicit_uris = [];
# Line 81  sub _parse ($$$$$) { Line 103  sub _parse ($$$$$) {
103    
104    ## Step 8-10    ## Step 8-10
105    unless ($$input =~ /^CACHE MANIFEST[\x20\x09]*(?![^\x0D\x0A])/gc) {    unless ($$input =~ /^CACHE MANIFEST[\x20\x09]*(?![^\x0D\x0A])/gc) {
106      $onerror->(type => 'not manifest', level => $must_level,      $onerror->(type => 'not manifest', level => $levels->{must},
107                 line => $line_number, column => 1); ## NOTE: MUST in syntax.                 line => $line_number, column => 1); ## NOTE: MUST in syntax.
108      return; ## Not a manifest.      return; ## Not a manifest.
109    }    }
# Line 99  sub _parse ($$$$$) { Line 121  sub _parse ($$$$$) {
121    START_OF_LINE: while (pos $$input < length $$input) {    START_OF_LINE: while (pos $$input < length $$input) {
122      $$input =~ /([\x0A\x0D\x20\x09]+)/gc;      $$input =~ /([\x0A\x0D\x20\x09]+)/gc;
123      my $v = $1;      my $v = $1;
124      $line_number++ for $v =~ /\x0D\x0A?|\x0D/g;      $line_number++ for $v =~ /\x0D\x0A?|\x0A/g;
125    
126      ## Step 14      ## Step 14
127      $$input =~ /([^\x0A\x0D]*)/gc;      $$input =~ /([^\x0A\x0D]*)/gc;
# Line 125  sub _parse ($$$$$) { Line 147  sub _parse ($$$$$) {
147        ## Step 20        ## Step 20
148        $mode = 'online whitelist';        $mode = 'online whitelist';
149        next START_OF_LINE;        next START_OF_LINE;
150        } elsif ($line =~ /:\z/) {
151          ## Step 21
152          $mode = 'unknown';
153    
154          $onerror->(type => 'manifest:unknown section',
155                     level => $levels->{must},
156                     line => $line_number, column => 1,
157                     value => $line);
158    
159          next START_OF_LINE;
160      }      }
161    
162      ## NOTE: "URIs that are to be fallback pages associated with      ## NOTE: "URIs that are to be fallback pages associated with
# Line 140  sub _parse ($$$$$) { Line 172  sub _parse ($$$$$) {
172      ## NOTE: "Relative URIs MUST be given relative to the manifest's own URI."      ## NOTE: "Relative URIs MUST be given relative to the manifest's own URI."
173      ## requirement in writing section can't be tested.      ## requirement in writing section can't be tested.
174    
175      ## Step 21      ## Step 22
176        ## "This is either a data line or it is syntactically incorrect."
177    
178        ## Step 23-26
179        my $tokens = [split /[\x09\x20]+/, $line];
180        shift @$tokens if $tokens->[0] eq ''; # leading white space
181        ## NOTE: Now, @$tokens contains at least one non-empty string.
182    
183        ## Step 27
184      if ($mode eq 'explicit') {      if ($mode eq 'explicit') {
185        my $uri = Message::DOM::DOMImplementation->create_uri_reference ($line);        if (@$tokens > 1) {
186            $onerror->(type => 'manifest:too many tokens',
187                       level => $levels->{must},
188                       line => $line_number, column => 1,
189                       value => $tokens->[1]);
190          }
191    
192          my $uri = Message::DOM::DOMImplementation->create_uri_reference
193              ($tokens->[0]);
194    
195        unless ($uri->is_iri_reference_3987) {        unless ($uri->is_iri_reference_3987) {
196          $onerror->(type => 'URI::syntax error:iriref3987',          $onerror->(type => 'syntax error:iriref3987',
197                     level => $must_level, line => $line_number, column => 1,                     level => $levels->{must},
198                       line => $line_number, column => 1,
199                     value => $line);                     value => $line);
200          next START_OF_LINE; ## NOTE: MUST in syntax.          next START_OF_LINE; ## NOTE: MUST in syntax.
201        }        }
# Line 155  sub _parse ($$$$$) { Line 204  sub _parse ($$$$$) {
204    
205        if (defined $uri->uri_fragment) {        if (defined $uri->uri_fragment) {
206          $uri->uri_fragment (undef);          $uri->uri_fragment (undef);
207          $onerror->(type => 'URI fragment not allowed',          $onerror->(type => 'URL fragment not allowed',
208                     level => $must_level, line => $line_number, column => 1,                     level => $levels->{must},
209                       line => $line_number, column => 1,
210                     value => $line);                     value => $line);
211          ## NOTE: MUST in writing section.          ## NOTE: MUST in writing section.
212        }        }
# Line 164  sub _parse ($$$$$) { Line 214  sub _parse ($$$$$) {
214        my $scheme = $uri->uri_scheme;        my $scheme = $uri->uri_scheme;
215        unless (defined $scheme and $scheme eq $m_scheme) {        unless (defined $scheme and $scheme eq $m_scheme) {
216          $onerror->(type => 'different scheme from manifest',          $onerror->(type => 'different scheme from manifest',
217                     level => $warn_level, line => $line_number, column => 1,                     level => $levels->{info},
218                       line => $line_number, column => 1,
219                     value => $uri->uri_reference);                     value => $uri->uri_reference);
220          next START_OF_LINE;          next START_OF_LINE;
221        }        }
222    
223        push @$explicit_uris, $uri->uri_reference;        push @$explicit_uris, $uri->uri_reference;
224      } elsif ($mode eq 'fallback') {      } elsif ($mode eq 'fallback') {
225        my ($p1, $p2) = split /[\x20\x09]+/, $line, 2;        if (@$tokens > 2) {
226            $onerror->(type => 'manifest:too many tokens',
227                       level => $levels->{must},
228                       line => $line_number, column => 1,
229                       value => $tokens->[2]);
230          }
231    
232          my ($p1, $p2) = (@$tokens);
233    
234        unless (defined $p2) {        unless (defined $p2) {
235          $onerror->(type => 'no fallback entry URI',          $onerror->(type => 'no fallback entry URL',
236                     level => $must_level, line => $line_number, column => 1,                     level => $levels->{must},
237                       line => $line_number, column => 1,
238                     value => $line);                     value => $line);
239    
240            ## ISSUE: The following is dropped in r2051 (error?)
241          next START_OF_LINE; ## NOTE: MUST in syntax.          next START_OF_LINE; ## NOTE: MUST in syntax.
242        }        }
243    
244        my $u1 = Message::DOM::DOMImplementation->create_uri_reference ($p1);        my $u1 = Message::DOM::DOMImplementation->create_uri_reference ($p1);
245    
246        unless ($u1->is_iri_reference_3987) {        unless ($u1->is_iri_reference_3987) {
247          $onerror->(type => 'URI::syntax error:iriref3987',          $onerror->(type => 'syntax error:iriref3987',
248                     level => $must_level, line => $line_number, column => 1,                     level => $levels->{must},
249                       line => $line_number, column => 1,
250                     index => 0, value => $p1);                     index => 0, value => $p1);
251          next START_OF_LINE; ## NOTE: MUST in syntax.          next START_OF_LINE; ## NOTE: MUST in syntax.
252        }        }
# Line 192  sub _parse ($$$$$) { Line 254  sub _parse ($$$$$) {
254        my $u2 = Message::DOM::DOMImplementation->create_uri_reference ($p2);        my $u2 = Message::DOM::DOMImplementation->create_uri_reference ($p2);
255    
256        unless ($u2->is_iri_reference_3987) {        unless ($u2->is_iri_reference_3987) {
257          $onerror->(type => 'URI::syntax error:iriref3987',          $onerror->(type => 'syntax error:iriref3987',
258                     level => $must_level, line => $line_number, column => 1,                     level => $levels->{must},
259                       line => $line_number, column => 1,
260                     index => 1, value => $p2);                     index => 1, value => $p2);
261          next START_OF_LINE; ## NOTE: MUST in syntax.          next START_OF_LINE; ## NOTE: MUST in syntax.
262        }        }
263    
264        if (defined $u1->uri_fragment) {        if (defined $u1->uri_fragment) {
265          $onerror->(type => 'URI fragment not allowed',          $u1->uri_fragment (undef);
266                     level => $must_level, line => $line_number, column => 1,          $onerror->(type => 'URL fragment not allowed',
267                       level => $levels->{must},
268                       line => $line_number, column => 1,
269                     index => 0, value => $p1);                     index => 0, value => $p1);
270          ## NOTE: MUST in writing section.          ## NOTE: MUST in writing section.
         ## ISSUE: Not dropped  
271        }        }
272    
273        if (defined $u2->uri_fragment) {        if (defined $u2->uri_fragment) {
274          $onerror->(type => 'URI fragment not allowed',          $u2->uri_fragment (undef);
275                     level => $must_level, line => $line_number, column => 1,          $onerror->(type => 'URL fragment not allowed',
276                       level => $levels->{must},
277                       line => $line_number, column => 1,
278                     index => 1, value => $p2);                     index => 1, value => $p2);
279          ## NOTE: MUST in writing section.          ## NOTE: MUST in writing section.
         ## ISSUE: Not dropped  
280        }        }
281    
282        $u1 = $u1->get_absolute_reference ($_[3]);        $u1 = $u1->get_absolute_reference ($_[3]);
# Line 219  sub _parse ($$$$$) { Line 284  sub _parse ($$$$$) {
284    
285        if (exists $fallback_uris->{$u1->uri_reference}) {        if (exists $fallback_uris->{$u1->uri_reference}) {
286          $onerror->(type => 'duplicate oc namespace',          $onerror->(type => 'duplicate oc namespace',
287                     level => $must_level, line => $line_number, column => 1,                     level => $levels->{must},
288                       line => $line_number, column => 1,
289                     index => 0, value => $u1->uri_reference);                     index => 0, value => $u1->uri_reference);
290          next START_OF_LINE; ## NOTE: MUST in syntax.          next START_OF_LINE; ## NOTE: MUST in syntax.
291        }        }
292                
293        unless ($same_shp->($u1)) {        unless ($same_origin->($u1)) {
294          $onerror->(type => 'different shp from manifest',          $onerror->(type => 'different origin from manifest',
295                     level => $must_level, line => $line_number, column => 1,                     level => $levels->{must},
296                       line => $line_number, column => 1,
297                     index => 0, value => $u1->uri_reference);                     index => 0, value => $u1->uri_reference);
298          next START_OF_LINE; ## NOTE: MUST in syntax.          next START_OF_LINE; ## NOTE: MUST in syntax.
299        }        }
# Line 234  sub _parse ($$$$$) { Line 301  sub _parse ($$$$$) {
301        my $u2_scheme = $u2->uri_scheme;        my $u2_scheme = $u2->uri_scheme;
302        unless (defined $u2_scheme and $u2_scheme eq $m_scheme) {        unless (defined $u2_scheme and $u2_scheme eq $m_scheme) {
303          $onerror->(type => 'different scheme from manifest',          $onerror->(type => 'different scheme from manifest',
304                     level => $warn_level, line => $line_number, column => 1,                     level => $levels->{info},
305                       line => $line_number, column => 1,
306                     index => 1, value => $u2->uri_reference);                     index => 1, value => $u2->uri_reference);
307          next START_OF_LINE;          next START_OF_LINE;
308        }        }
309    
310        $fallback_uris->{$u1->uri_reference} = $u2->uri_reference;        $fallback_uris->{$u1->uri_reference} = $u2->uri_reference;
311      } elsif ($mode eq 'online whitelist') {      } elsif ($mode eq 'online whitelist') {
312        my $uri = Message::DOM::DOMImplementation->create_uri_reference ($line);        if (@$tokens > 1) {
313            $onerror->(type => 'manifest:too many tokens',
314                       level => $levels->{must},
315                       line => $line_number, column => 1,
316                       value => $tokens->[1]);
317          }
318    
319          my $uri = Message::DOM::DOMImplementation->create_uri_reference
320              ($tokens->[0]);
321    
322        unless ($uri->is_iri_reference_3987) {        unless ($uri->is_iri_reference_3987) {
323          $onerror->(type => 'URI::syntax error:iriref3987',          $onerror->(type => 'syntax error:iriref3987',
324                     level => $must_level, line => $line_number, column => 1,                     level => $levels->{must},
325                       line => $line_number, column => 1,
326                     value => $line);                     value => $line);
327          next START_OF_LINE; ## NOTE: MUST in syntax.          next START_OF_LINE; ## NOTE: MUST in syntax.
328        }        }
# Line 254  sub _parse ($$$$$) { Line 331  sub _parse ($$$$$) {
331    
332        if (defined $uri->uri_fragment) {        if (defined $uri->uri_fragment) {
333          $uri->uri_fragment (undef);          $uri->uri_fragment (undef);
334          $onerror->(type => 'URI fragment not allowed',          $onerror->(type => 'URL fragment not allowed',
335                     level => $must_level, line => $line_number, column => 1,                     level => $levels->{must},
336                       line => $line_number, column => 1,
337                     value => $line);                     value => $line);
338          ## NOTE: MUST in writing section.          ## NOTE: MUST in writing section.
339        }        }
# Line 263  sub _parse ($$$$$) { Line 341  sub _parse ($$$$$) {
341        my $scheme = $uri->uri_scheme;        my $scheme = $uri->uri_scheme;
342        unless (defined $scheme and $scheme eq $m_scheme) {        unless (defined $scheme and $scheme eq $m_scheme) {
343          $onerror->(type => 'different scheme from manifest',          $onerror->(type => 'different scheme from manifest',
344                     level => $warn_level, line => $line_number, column => 1,                     level => $levels->{info},
345                       line => $line_number, column => 1,
346                     value => $uri->uri_reference);                     value => $uri->uri_reference);
347          next START_OF_LINE;          next START_OF_LINE;
348        }        }
349    
350        push @$online_whitelist_uris, $uri->uri_reference;              push @$online_whitelist_uris, $uri->uri_reference;      
351        } elsif ($mode eq 'unknown') {
352          ## NOTE: Do nothing.
353          ## NOTE: No informational message is thrown, since when the mode
354          ## is switched to the "unknown" state an error is raised.
355      }      }
356    
357      ## Step 22      ## Step 28
358      #next START_OF_LINE;      #next START_OF_LINE;
359    } # START_OF_LINE    } # START_OF_LINE
360    
361    ## Step 23    ## Step 29
362    return [$explicit_uris, $fallback_uris, $online_whitelist_uris,    return [$explicit_uris, $fallback_uris, $online_whitelist_uris,
363            $m_uri->uri_reference];            $m_uri->uri_reference];
364  } # _parse  } # _parse
365    
366  sub check_manifest ($$$) {  sub check_manifest ($$$;$) {
367    my (undef, $manifest, $onerror) = @_;    my (undef, $manifest, $onerror, $levels) = @_;
368    
369    my $listed = {};    my $listed = {};
370    my $must_level = 'm';  
371      $levels ||= $default_error_levels;
372    
373    require Whatpm::URIChecker;    require Whatpm::URIChecker;
374    
# Line 293  sub check_manifest ($$$) { Line 377  sub check_manifest ($$$) {
377      $listed->{$uri} = 1;      $listed->{$uri} = 1;
378    
379      Whatpm::URIChecker->check_iri_reference ($uri, sub {      Whatpm::URIChecker->check_iri_reference ($uri, sub {
380        my %opt = @_;        $onerror->(value => $uri, @_, index => $i);
       $onerror->(level => $opt{level}, value => $uri,  
                  index => $i,  
                  type => 'URI::'.$opt{type}.  
                  (defined $opt{position} ? ':'.$opt{position} : ''));  
381      });      });
382    
383      ## ISSUE: Literal equivalence, right?      ## ISSUE: Literal equivalence, right?
384      if ($uri eq $manifest->[3]) {      if ($uri eq $manifest->[3]) {
385        $onerror->(level => $must_level, value => $uri,        $onerror->(level => $levels->{must}, value => $uri,
386                   index => $i,                   index => $i,
387                   type => 'manifest URI');                   type => 'same as manifest URL');
388      }      }
389    
390      $i++;      $i++;
# Line 312  sub check_manifest ($$$) { Line 392  sub check_manifest ($$$) {
392    
393    for my $uri1 (sort {$a cmp $b} keys %{$manifest->[1]}) {    for my $uri1 (sort {$a cmp $b} keys %{$manifest->[1]}) {
394      Whatpm::URIChecker->check_iri_reference ($uri1, sub {      Whatpm::URIChecker->check_iri_reference ($uri1, sub {
395        my %opt = @_;        $onerror->(value => $uri1, @_, index => 0);
       $onerror->(level => $opt{level}, index => 0, value => $uri1,  
                  type => 'URI::'.$opt{type}.  
                  (defined $opt{position} ? ':'.$opt{position} : ''));  
396      });      });
397    
398      if ($uri1 eq $manifest->[3]) {      if ($uri1 eq $manifest->[3]) {
399        $onerror->(level => $must_level, value => $uri1,        $onerror->(level => $levels->{must}, value => $uri1,
400                   index => $i,                   index => $i,
401                   type => 'manifest URI');                   type => 'same as manifest URL');
402      }      }
403    
404      $i++;      $i++;
# Line 330  sub check_manifest ($$$) { Line 407  sub check_manifest ($$$) {
407      $listed->{$uri2} = 1;      $listed->{$uri2} = 1;
408    
409      Whatpm::URIChecker->check_iri_reference ($uri2, sub {      Whatpm::URIChecker->check_iri_reference ($uri2, sub {
410        my %opt = @_;        $onerror->(value => $uri2, @_, index => 1);
       $onerror->(level => $opt{level}, index => 1, value => $uri2,  
                  index => $i,  
                  type => 'URI::'.$opt{type}.  
                  (defined $opt{position} ? ':'.$opt{position} : ''));  
411      });      });
412    
413      if ($uri2 eq $manifest->[3]) {      if ($uri2 eq $manifest->[3]) {
414        $onerror->(level => $must_level, value => $uri2,        $onerror->(level => $levels->{must}, value => $uri2,
415                   index => $i,                   index => $i,
416                   type => 'manifest URI');                   type => 'same as manifest URL');
417      }      }
418    
419      $i++;      $i++;
# Line 350  sub check_manifest ($$$) { Line 423  sub check_manifest ($$$) {
423      if ($listed->{$uri}) {      if ($listed->{$uri}) {
424        $onerror->(type => 'both in entries and whitelist',        $onerror->(type => 'both in entries and whitelist',
425                   index => $i,                   index => $i,
426                   level => $must_level, value => $uri);                   level => $levels->{must}, value => $uri);
427        ## NOTE: MUST in writing section.        ## NOTE: MUST in writing section.
428      }      }
429    
430      Whatpm::URIChecker->check_iri_reference ($uri, sub {      Whatpm::URIChecker->check_iri_reference ($uri, sub {
431        my %opt = @_;        $onerror->(value => $uri, @_, index => $i);
       $onerror->(level => $opt{level}, value => $uri,  
                  index => $i,  
                  type => 'URI::'.$opt{type}.  
                  (defined $opt{position} ? ':'.$opt{position} : ''));  
432      });      });
433    
434      if ($uri eq $manifest->[3]) {      if ($uri eq $manifest->[3]) {
435        $onerror->(level => $must_level, value => $uri,        $onerror->(level => $levels->{must}, value => $uri,
436                   index => $i,                   index => $i,
437                   type => 'manifest URI');                   type => 'same as manifest URL');
438      }      }
439    
440      $i++;      $i++;
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.8
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24