Fossil SCM
Added more checks to the RCS parser to detect bogus symbol names and problematic log messages. Added ability to rewind back to the beginning of the last recognized token for a nicer positioned error message.
Commit
1527954d87e2e530b81531d90444e43e149cfee6
Parent
a766b08198e86c8…
1 file changed
+27
| --- tools/cvs2fossil/lib/rcsparser.tcl | ||
| +++ tools/cvs2fossil/lib/rcsparser.tcl | ||
| @@ -76,10 +76,14 @@ | ||
| 76 | 76 | } |
| 77 | 77 | |
| 78 | 78 | proc Symbols {} { |
| 79 | 79 | RequiredLiteral symbols |
| 80 | 80 | while {[Ident -> symbol]} { |
| 81 | + if {*$} $symbol]} { | |
| 82 | + Rewind | |
| 83 | + Bad {symbol name} | |
| 84 | + } | |
| 81 | 85 | RequiredNumber -> rev |
| 82 | 86 | Call deftag $symbol $rev |
| 83 | 87 | } |
| 84 | 88 | Semicolon |
| 85 | 89 | return |
| @@ -215,10 +219,15 @@ | ||
| 215 | 219 | |
| 216 | 220 | proc DeltaTexts {} { |
| 217 | 221 | while {[OptionalNumber -> rev]} { |
| 218 | 222 | RequiredLiteral log |
| 219 | 223 | RequiredString -> cmsg |
| 224 | + if {[regexp {[\000-\010\013\014\016-\037]} $cmsg]} { | |
| 225 | + Rewind | |
| 226 | + Bad "log message for $rev contains at least one control character" | |
| 227 | + } | |
| 228 | + | |
| 220 | 229 | RequiredLiteral text |
| 221 | 230 | RequiredStringRange -> delta |
| 222 | 231 | Call extend $rev $cmsg $delta |
| 223 | 232 | } |
| 224 | 233 | return |
| @@ -385,29 +394,47 @@ | ||
| 385 | 394 | # Note: The indices are absolute!, not relative to the start |
| 386 | 395 | # location. |
| 387 | 396 | upvar 1 $mv match |
| 388 | 397 | ::variable mypos |
| 389 | 398 | ::variable mysize |
| 399 | + ::variable mylastpos | |
| 390 | 400 | |
| 391 | 401 | struct::list assign $match s e |
| 392 | 402 | #puts "<$s $e> [info level -1]" |
| 393 | 403 | |
| 404 | + set mylastpos $mypos | |
| 394 | 405 | set mypos $e |
| 395 | 406 | incr mypos |
| 396 | 407 | |
| 397 | 408 | log progress 2 rcs $mypos $mysize |
| 398 | 409 | #puts $mypos/$mysize |
| 399 | 410 | return |
| 400 | 411 | } |
| 412 | + | |
| 413 | + proc Rewind {} { | |
| 414 | + ::variable mypos | |
| 415 | + ::variable mylastpos | |
| 416 | + | |
| 417 | + set mypos $mylastpos | |
| 418 | + return | |
| 419 | + } | |
| 401 | 420 | |
| 402 | 421 | proc Expected {x} { |
| 403 | 422 | ::variable mydata |
| 404 | 423 | ::variable mypos |
| 405 | 424 | set e $mypos ; incr e 30 |
| 406 | 425 | return -code error -errorcode vc::rcs::parser \ |
| 407 | 426 | "Expected $x @ '[string range $mydata $mypos $e]...'" |
| 408 | 427 | } |
| 428 | + | |
| 429 | + proc Bad {x} { | |
| 430 | + ::variable mydata | |
| 431 | + ::variable mypos | |
| 432 | + set e $mypos ; incr e 30 | |
| 433 | + return -code error -errorcode vc::rcs::parser \ | |
| 434 | + "Bad $x @ '[string range $mydata $mypos $e]...'" | |
| 435 | + } | |
| 409 | 436 | |
| 410 | 437 | # # ## ### ##### ######## ############# |
| 411 | 438 | ## Setup, callbacks. |
| 412 | 439 | |
| 413 | 440 | proc Initialize {path sink} { |
| 414 | 441 |
| --- tools/cvs2fossil/lib/rcsparser.tcl | |
| +++ tools/cvs2fossil/lib/rcsparser.tcl | |
| @@ -76,10 +76,14 @@ | |
| 76 | } |
| 77 | |
| 78 | proc Symbols {} { |
| 79 | RequiredLiteral symbols |
| 80 | while {[Ident -> symbol]} { |
| 81 | RequiredNumber -> rev |
| 82 | Call deftag $symbol $rev |
| 83 | } |
| 84 | Semicolon |
| 85 | return |
| @@ -215,10 +219,15 @@ | |
| 215 | |
| 216 | proc DeltaTexts {} { |
| 217 | while {[OptionalNumber -> rev]} { |
| 218 | RequiredLiteral log |
| 219 | RequiredString -> cmsg |
| 220 | RequiredLiteral text |
| 221 | RequiredStringRange -> delta |
| 222 | Call extend $rev $cmsg $delta |
| 223 | } |
| 224 | return |
| @@ -385,29 +394,47 @@ | |
| 385 | # Note: The indices are absolute!, not relative to the start |
| 386 | # location. |
| 387 | upvar 1 $mv match |
| 388 | ::variable mypos |
| 389 | ::variable mysize |
| 390 | |
| 391 | struct::list assign $match s e |
| 392 | #puts "<$s $e> [info level -1]" |
| 393 | |
| 394 | set mypos $e |
| 395 | incr mypos |
| 396 | |
| 397 | log progress 2 rcs $mypos $mysize |
| 398 | #puts $mypos/$mysize |
| 399 | return |
| 400 | } |
| 401 | |
| 402 | proc Expected {x} { |
| 403 | ::variable mydata |
| 404 | ::variable mypos |
| 405 | set e $mypos ; incr e 30 |
| 406 | return -code error -errorcode vc::rcs::parser \ |
| 407 | "Expected $x @ '[string range $mydata $mypos $e]...'" |
| 408 | } |
| 409 | |
| 410 | # # ## ### ##### ######## ############# |
| 411 | ## Setup, callbacks. |
| 412 | |
| 413 | proc Initialize {path sink} { |
| 414 |
| --- tools/cvs2fossil/lib/rcsparser.tcl | |
| +++ tools/cvs2fossil/lib/rcsparser.tcl | |
| @@ -76,10 +76,14 @@ | |
| 76 | } |
| 77 | |
| 78 | proc Symbols {} { |
| 79 | RequiredLiteral symbols |
| 80 | while {[Ident -> symbol]} { |
| 81 | if {*$} $symbol]} { |
| 82 | Rewind |
| 83 | Bad {symbol name} |
| 84 | } |
| 85 | RequiredNumber -> rev |
| 86 | Call deftag $symbol $rev |
| 87 | } |
| 88 | Semicolon |
| 89 | return |
| @@ -215,10 +219,15 @@ | |
| 219 | |
| 220 | proc DeltaTexts {} { |
| 221 | while {[OptionalNumber -> rev]} { |
| 222 | RequiredLiteral log |
| 223 | RequiredString -> cmsg |
| 224 | if {[regexp {[\000-\010\013\014\016-\037]} $cmsg]} { |
| 225 | Rewind |
| 226 | Bad "log message for $rev contains at least one control character" |
| 227 | } |
| 228 | |
| 229 | RequiredLiteral text |
| 230 | RequiredStringRange -> delta |
| 231 | Call extend $rev $cmsg $delta |
| 232 | } |
| 233 | return |
| @@ -385,29 +394,47 @@ | |
| 394 | # Note: The indices are absolute!, not relative to the start |
| 395 | # location. |
| 396 | upvar 1 $mv match |
| 397 | ::variable mypos |
| 398 | ::variable mysize |
| 399 | ::variable mylastpos |
| 400 | |
| 401 | struct::list assign $match s e |
| 402 | #puts "<$s $e> [info level -1]" |
| 403 | |
| 404 | set mylastpos $mypos |
| 405 | set mypos $e |
| 406 | incr mypos |
| 407 | |
| 408 | log progress 2 rcs $mypos $mysize |
| 409 | #puts $mypos/$mysize |
| 410 | return |
| 411 | } |
| 412 | |
| 413 | proc Rewind {} { |
| 414 | ::variable mypos |
| 415 | ::variable mylastpos |
| 416 | |
| 417 | set mypos $mylastpos |
| 418 | return |
| 419 | } |
| 420 | |
| 421 | proc Expected {x} { |
| 422 | ::variable mydata |
| 423 | ::variable mypos |
| 424 | set e $mypos ; incr e 30 |
| 425 | return -code error -errorcode vc::rcs::parser \ |
| 426 | "Expected $x @ '[string range $mydata $mypos $e]...'" |
| 427 | } |
| 428 | |
| 429 | proc Bad {x} { |
| 430 | ::variable mydata |
| 431 | ::variable mypos |
| 432 | set e $mypos ; incr e 30 |
| 433 | return -code error -errorcode vc::rcs::parser \ |
| 434 | "Bad $x @ '[string range $mydata $mypos $e]...'" |
| 435 | } |
| 436 | |
| 437 | # # ## ### ##### ######## ############# |
| 438 | ## Setup, callbacks. |
| 439 | |
| 440 | proc Initialize {path sink} { |
| 441 |