← Back to branch summary

~ubuntu-branches/ubuntu/raring/tclvfs/raring

« back to all changes in this revision

Viewing changes to library/zipvfs.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Sergei Golovan
  • Date: 2007-09-16 21:53:34 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20070916215334-j27kdicwlmj7bqdx
Tags: 1.3-20070620-1
* New CVS snapshot.
* Added uscan control script debian/watch.
* Rewritten clean target in debian/rules to ignore only missing Makefile
  error.
* Made clean-patched target in debian/rules depend on patch-stamp.

Show diffs side-by-side

added added

removed removed

Lines of Context:
library/zipvfs.tcl
240
240
    set time [u_short $time]
241
241
    set date [u_short $date]
242
242
 
243
 
    set sec [expr { ($time & 0x1F) * 2 }]
244
 
    set min [expr { ($time >> 5) & 0x3F }]
 
243
    # time = fedcba9876543210
 
244
    #        HHHHHmmmmmmSSSSS (sec/2 actually)
 
245
 
 
246
    # data = fedcba9876543210
 
247
    #        yyyyyyyMMMMddddd
 
248
 
 
249
    set sec  [expr { ($time & 0x1F) * 2 }]
 
250
    set min  [expr { ($time >> 5) & 0x3F }]
245
251
    set hour [expr { ($time >> 11) & 0x1F }]
246
252
 
247
253
    set mday [expr { $date & 0x1F }]
248
 
    set mon [expr { (($date >> 5) & 0xF) }]
 
254
    set mon  [expr { (($date >> 5) & 0xF) }]
249
255
    set year [expr { (($date >> 9) & 0xFF) + 1980 }]
250
256
 
251
 
    set dt [format {%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d} \
252
 
        $year $mon $mday $hour $min $sec]
253
 
    return [clock scan $dt -gmt 1]
 
257
    # Fix up bad date/time data, no need to fail
 
258
    while {$sec  > 59} {incr sec  -60}
 
259
    while {$min  > 59} {incr sec  -60}
 
260
    while {$hour > 23} {incr hour -24}
 
261
    if {$mday < 1}  {incr mday}
 
262
    if {$mon  < 1}  {incr mon}
 
263
    while {$mon > 12} {incr hour -12}
 
264
 
 
265
    while {[catch {
 
266
        set dt [format {%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d} \
 
267
                    $year $mon $mday $hour $min $sec]
 
268
        set res [clock scan $dt -gmt 1]
 
269
    }]} {
 
270
        # Only mday can be wrong, at end of month
 
271
        incr mday -1
 
272
    }
 
273
    return $res
254
274
}
255
275
 
256
276
 
330
350
 
331
351
    # [SF Tclvfs Bug 1003574]. Do not seek over beginning of file.
332
352
    seek $fd 0 end
333
 
    set n [tell $fd]
334
 
    if {$n < 512} {set n -$n} else {set n -512}
335
 
    seek $fd $n end
336
 
 
337
 
    set hdr [read $fd 512]
338
 
    set pos [string first "PK\05\06" $hdr]
339
 
    if {$pos == -1} {
340
 
        error "no header found"
 
353
 
 
354
    # Just looking in the last 512 bytes may be enough to handle zip
 
355
    # archives without comments, however for archives which have
 
356
    # comments the chunk may start at an arbitrary distance from the
 
357
    # end of the file. So if we do not find the header immediately
 
358
    # we have to extend the range of our search, possibly until we
 
359
    # have a large part of the archive in memory. We can fail only
 
360
    # after the whole file has been searched.
 
361
 
 
362
    set sz  [tell $fd]
 
363
    set len 512
 
364
    set at  512
 
365
    while {1} {
 
366
        if {$sz < $at} {set n -$sz} else {set n -$at}
 
367
 
 
368
        seek $fd $n end
 
369
        set hdr [read $fd $len]
 
370
        set pos [string first "PK\05\06" $hdr]
 
371
        if {$pos == -1} {
 
372
            if {$at >= $sz} {
 
373
                return -code error "no header found"
 
374
            }
 
375
            set len 540 ; # after 1st iteration we force overlap with last buffer
 
376
            incr at 512 ; # to ensure that the pattern we look for is not split at
 
377
            #           ; # a buffer boundary, nor the header itself
 
378
        } else {
 
379
            break
 
380
        }
341
381
    }
 
382
 
342
383
    set hdr [string range $hdr [expr $pos + 4] [expr $pos + 21]]
343
384
    set pos [expr [tell $fd] + $pos - 512]
344
385