From 22e93659eda869656f213666474b3ed68b232b5f Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Thu, 26 Sep 2024 00:41:18 +1000 Subject: [PATCH] punk8win.vfs add tklib08, punk::nav::fs fixes, add tar to bootsupport --- src/bootsupport/lib/tar/ChangeLog | 186 + src/bootsupport/lib/tar/pkgIndex.tcl | 5 + src/bootsupport/lib/tar/tar.man | 202 + src/bootsupport/lib/tar/tar.pcx | 83 + src/bootsupport/lib/tar/tar.tcl | 550 + src/bootsupport/lib/tar/tar.test | 139 + src/bootsupport/lib/tar/tests/support.tcl | 149 + src/bootsupport/modules/punk/nav/fs-0.1.0.tm | 53 +- src/modules/punk/nav/fs-999999.0a1.0.tm | 53 +- .../bootsupport/modules/punk/nav/fs-0.1.0.tm | 53 +- .../bootsupport/modules/punk/nav/fs-0.1.0.tm | 53 +- src/runtime/mapvfs.config | 2 +- src/vfs/_vfscommon/modules/punk/du-0.1.0.tm | 238 +- .../_vfscommon/modules/punk/nav/fs-0.1.0.tm | 156 +- .../_vfscommon/modules/punk/winlnk-0.1.0.tm | 2 +- .../tklib0.8/autoscroll/autoscroll.tcl | 238 + .../lib_tcl8/tklib0.8/autoscroll/pkgIndex.tcl | 13 + .../lib_tcl8/tklib0.8/canvas/canvas_drag.tcl | 278 + .../tklib0.8/canvas/canvas_ecircle.tcl | 383 + .../tklib0.8/canvas/canvas_epoints.tcl | 453 + .../tklib0.8/canvas/canvas_epolyline.tcl | 660 ++ .../lib_tcl8/tklib0.8/canvas/canvas_equad.tcl | 400 + .../tklib0.8/canvas/canvas_erectangle.tcl | 452 + .../tklib0.8/canvas/canvas_gradient.tcl | 278 + .../tklib0.8/canvas/canvas_highlight.tcl | 106 + .../lib_tcl8/tklib0.8/canvas/canvas_mvg.tcl | 392 + .../lib_tcl8/tklib0.8/canvas/canvas_snap.tcl | 111 + .../lib_tcl8/tklib0.8/canvas/canvas_sqmap.tcl | 667 ++ .../lib_tcl8/tklib0.8/canvas/canvas_tags.tcl | 70 + .../tklib0.8/canvas/canvas_trlines.tcl | 95 + .../lib_tcl8/tklib0.8/canvas/canvas_zoom.tcl | 181 + .../lib_tcl8/tklib0.8/canvas/pkgIndex.tcl | 16 + .../tklib0.8/chatwidget/chatwidget.tcl | 777 ++ .../lib_tcl8/tklib0.8/chatwidget/pkgIndex.tcl | 1 + .../tklib0.8/controlwidget/bindDown.tcl | 45 + .../tklib0.8/controlwidget/controlwidget.tcl | 17 + .../lib_tcl8/tklib0.8/controlwidget/led.tcl | 127 + .../tklib0.8/controlwidget/pkgIndex.tcl | 23 + .../tklib0.8/controlwidget/radioMatrix.tcl | 253 + .../lib_tcl8/tklib0.8/controlwidget/rdial.tcl | 455 + .../tklib0.8/controlwidget/tachometer.tcl | 389 + .../tklib0.8/controlwidget/vertical_meter.tcl | 1458 +++ .../tklib0.8/controlwidget/voltmeter.tcl | 347 + .../lib_tcl8/tklib0.8/crosshair/crosshair.tcl | 598 ++ .../lib_tcl8/tklib0.8/crosshair/pkgIndex.tcl | 4 + .../lib_tcl8/tklib0.8/ctext/ctext.tcl | 1113 ++ .../lib_tcl8/tklib0.8/ctext/pkgIndex.tcl | 1 + .../lib_tcl8/tklib0.8/cursor/cursor.tcl | 137 + .../lib_tcl8/tklib0.8/cursor/pkgIndex.tcl | 1 + .../lib_tcl8/tklib0.8/datefield/datefield.tcl | 456 + .../lib_tcl8/tklib0.8/datefield/pkgIndex.tcl | 1 + .../tklib0.8/diagrams/application.tcl | 470 + .../lib_tcl8/tklib0.8/diagrams/attributes.tcl | 383 + .../lib_tcl8/tklib0.8/diagrams/basic.tcl | 1279 +++ .../lib_tcl8/tklib0.8/diagrams/core.tcl | 1120 ++ .../lib_tcl8/tklib0.8/diagrams/diagram.tcl | 62 + .../lib_tcl8/tklib0.8/diagrams/direction.tcl | 254 + .../lib_tcl8/tklib0.8/diagrams/element.tcl | 298 + .../lib_tcl8/tklib0.8/diagrams/navigation.tcl | 138 + .../lib_tcl8/tklib0.8/diagrams/pkgIndex.tcl | 15 + .../lib_tcl8/tklib0.8/diagrams/point.tcl | 184 + .../lib_tcl8/tklib0.8/getstring/pkgIndex.tcl | 13 + .../tklib0.8/getstring/tk_getString.tcl | 124 + .../lib_tcl8/tklib0.8/history/history.tcl | 113 + .../lib_tcl8/tklib0.8/history/pkgIndex.tcl | 13 + .../lib_tcl8/tklib0.8/ico/ico.tcl | 1467 +++ .../lib_tcl8/tklib0.8/ico/ico0.tcl | 1193 +++ .../lib_tcl8/tklib0.8/ico/pkgIndex.tcl | 9 + .../lib_tcl8/tklib0.8/ipentry/ipentry.tcl | 975 ++ .../lib_tcl8/tklib0.8/ipentry/pkgIndex.tcl | 3 + .../lib_tcl8/tklib0.8/khim/ROOT.msg | 74 + .../lib_tcl8/tklib0.8/khim/cs.msg | 108 + .../lib_tcl8/tklib0.8/khim/da.msg | 104 + .../lib_tcl8/tklib0.8/khim/de.msg | 123 + .../lib_tcl8/tklib0.8/khim/en.msg | 114 + .../lib_tcl8/tklib0.8/khim/es.msg | 108 + .../lib_tcl8/tklib0.8/khim/khim.tcl | 2028 ++++ .../lib_tcl8/tklib0.8/khim/pkgIndex.tcl | 11 + .../lib_tcl8/tklib0.8/khim/pl.msg | 113 + .../lib_tcl8/tklib0.8/khim/ru.msg | 124 + .../lib_tcl8/tklib0.8/khim/uk.msg | 117 + .../lib_tcl8/tklib0.8/mentry/mentry.tcl | 13 + .../lib_tcl8/tklib0.8/mentry/mentryCommon.tcl | 115 + .../lib_tcl8/tklib0.8/mentry/mentry_tile.tcl | 24 + .../lib_tcl8/tklib0.8/mentry/pkgIndex.tcl | 27 + .../mentry/scripts/mentryDateTime.tcl | 863 ++ .../mentry/scripts/mentryFixedPoint.tcl | 142 + .../tklib0.8/mentry/scripts/mentryIPAddr.tcl | 244 + .../mentry/scripts/mentryIPv6Addr.tcl | 282 + .../tklib0.8/mentry/scripts/mentryThemes.tcl | 675 ++ .../tklib0.8/mentry/scripts/mentryWidget.tcl | 2404 +++++ .../tklib0.8/mentry/scripts/mwutil/mwutil.tcl | 760 ++ .../mentry/scripts/mwutil/pkgIndex.tcl | 7 + .../lib_tcl8/tklib0.8/mentry/scripts/tclIndex | 111 + .../lib_tcl8/tklib0.8/menubar/debug.tcl | 226 + .../lib_tcl8/tklib0.8/menubar/menubar.tcl | 1920 ++++ .../lib_tcl8/tklib0.8/menubar/node.tcl | 161 + .../lib_tcl8/tklib0.8/menubar/pkgIndex.tcl | 4 + .../lib_tcl8/tklib0.8/menubar/tree.tcl | 1101 ++ .../tklib0.8/notifywindow/notifywindow.tcl | 105 + .../tklib0.8/notifywindow/pkgIndex.tcl | 11 + .../lib_tcl8/tklib0.8/ntext/ntext.tcl | 3603 +++++++ .../lib_tcl8/tklib0.8/ntext/pkgIndex.tcl | 2 + .../persistentSelection.tcl | 907 ++ .../tklib0.8/persistentSelection/pkgIndex.tcl | 2 + .../lib_tcl8/tklib0.8/pkgIndex.tcl | 45 + .../lib_tcl8/tklib0.8/plotchart/pkgIndex.tcl | 7 + .../lib_tcl8/tklib0.8/plotchart/plot3d.tcl | 431 + .../lib_tcl8/tklib0.8/plotchart/plotanim.tcl | 607 ++ .../lib_tcl8/tklib0.8/plotchart/plotannot.tcl | 450 + .../lib_tcl8/tklib0.8/plotchart/plotaxis.tcl | 2207 ++++ .../lib_tcl8/tklib0.8/plotchart/plotbind.tcl | 263 + .../tklib0.8/plotchart/plotbusiness.tcl | 386 + .../lib_tcl8/tklib0.8/plotchart/plotchart.tcl | 3481 ++++++ .../tklib0.8/plotchart/plotcombined.tcl | 189 + .../tklib0.8/plotchart/plotconfig.tcl | 443 + .../tklib0.8/plotchart/plotcontour.tcl | 1861 ++++ .../tklib0.8/plotchart/plotdendrogram.tcl | 255 + .../lib_tcl8/tklib0.8/plotchart/plotgantt.tcl | 345 + .../tklib0.8/plotchart/plotobject.tcl | 274 + .../lib_tcl8/tklib0.8/plotchart/plotpack.tcl | 377 + .../lib_tcl8/tklib0.8/plotchart/plotpriv.tcl | 4740 ++++++++ .../lib_tcl8/tklib0.8/plotchart/plotscada.tcl | 274 + .../tklib0.8/plotchart/plotspecial.tcl | 624 ++ .../tklib0.8/plotchart/plotstatustimeline.tcl | 228 + .../lib_tcl8/tklib0.8/plotchart/plottable.tcl | 327 + .../lib_tcl8/tklib0.8/plotchart/scaling.tcl | 200 + .../lib_tcl8/tklib0.8/plotchart/xyplot.tcl | 579 + .../lib_tcl8/tklib0.8/scrollutil/pkgIndex.tcl | 27 + .../tklib0.8/scrollutil/scripts/attrib.tcl | 78 + .../scrollutil/scripts/notebookImages.tcl | 664 ++ .../tklib0.8/scrollutil/scripts/pagesman.tcl | 847 ++ .../scrollutil/scripts/plainnotebook.tcl | 1840 ++++ .../scrollutil/scripts/scrollableframe.tcl | 1216 +++ .../scrollutil/scripts/scrollarea.tcl | 1248 +++ .../scrollutil/scripts/scrollednotebook.tcl | 1933 ++++ .../scrollutil/scripts/scrollsync.tcl | 625 ++ .../tklib0.8/scrollutil/scripts/tclIndex | 208 + .../utils/indicatorImgs/gifIndicatorImgs.tcl | 1641 +++ .../utils/indicatorImgs/svgIndicatorImgs.tcl | 373 + .../scripts/utils/indicatorImgs/tclIndex | 20 + .../scrollutil/scripts/utils/mwutil.tcl | 760 ++ .../scrollutil/scripts/utils/pkgIndex.tcl | 9 + .../scrollutil/scripts/utils/scaleutil.tcl | 838 ++ .../scrollutil/scripts/utils/themepatch.tcl | 392 + .../scrollutil/scripts/wheelEvent.tcl | 834 ++ .../tklib0.8/scrollutil/scrollutil.tcl | 20 + .../tklib0.8/scrollutil/scrollutilCommon.tcl | 116 + .../tklib0.8/scrollutil/scrollutil_tile.tcl | 36 + .../lib_tcl8/tklib0.8/shtmlview/pkgIndex.tcl | 2 + .../tklib0.8/shtmlview/shtmlview-doctools.tcl | 46 + .../tklib0.8/shtmlview/shtmlview-mkdoc.tcl | 47 + .../lib_tcl8/tklib0.8/shtmlview/shtmlview.tcl | 3555 ++++++ .../lib_tcl8/tklib0.8/style/as.tcl | 514 + .../lib_tcl8/tklib0.8/style/lobster.tcl | 90 + .../lib_tcl8/tklib0.8/style/pkgIndex.tcl | 13 + .../lib_tcl8/tklib0.8/style/style.tcl | 33 + .../lib_tcl8/tklib0.8/swaplist/pkgIndex.tcl | 13 + .../lib_tcl8/tklib0.8/swaplist/swaplist.tcl | 386 + .../lib_tcl8/tklib0.8/tablelist/pkgIndex.tcl | 27 + .../tklib0.8/tablelist/scripts/pencil.cur | Bin 0 -> 4286 bytes .../tklib0.8/tablelist/scripts/repair.tcl | 84 + .../tablelist/scripts/tablelistBind.tcl | 4752 ++++++++ .../tablelist/scripts/tablelistConfig.tcl | 4385 ++++++++ .../tablelist/scripts/tablelistEdit.tcl | 3254 ++++++ .../tablelist/scripts/tablelistImages.tcl | 3936 +++++++ .../tablelist/scripts/tablelistMove.tcl | 591 + .../tablelist/scripts/tablelistSort.tcl | 766 ++ .../tablelist/scripts/tablelistThemes.tcl | 2061 ++++ .../tablelist/scripts/tablelistUtil.tcl | 7124 ++++++++++++ .../tablelist/scripts/tablelistWidget.tcl | 9544 +++++++++++++++++ .../tklib0.8/tablelist/scripts/tclIndex | 681 ++ .../utils/indicatorImgs/gifIndicatorImgs.tcl | 1641 +++ .../utils/indicatorImgs/svgIndicatorImgs.tcl | 373 + .../scripts/utils/indicatorImgs/tclIndex | 20 + .../tablelist/scripts/utils/mwutil.tcl | 760 ++ .../tablelist/scripts/utils/pkgIndex.tcl | 11 + .../tablelist/scripts/utils/scaleutil.tcl | 838 ++ .../tablelist/scripts/utils/scaleutilMisc.tcl | 680 ++ .../tablelist/scripts/utils/themepatch.tcl | 392 + .../lib_tcl8/tklib0.8/tablelist/tablelist.tcl | 14 + .../tklib0.8/tablelist/tablelistCommon.tcl | 129 + .../tklib0.8/tablelist/tablelist_tile.tcl | 24 + .../lib_tcl8/tklib0.8/tkpiechart/boxlabel.tcl | 141 + .../lib_tcl8/tklib0.8/tkpiechart/canlabel.tcl | 206 + .../lib_tcl8/tklib0.8/tkpiechart/labarray.tcl | 103 + .../lib_tcl8/tklib0.8/tkpiechart/objselec.tcl | 37 + .../tklib0.8/tkpiechart/perilabel.tcl | 222 + .../lib_tcl8/tklib0.8/tkpiechart/pie.tcl | 391 + .../lib_tcl8/tklib0.8/tkpiechart/pielabel.tcl | 41 + .../lib_tcl8/tklib0.8/tkpiechart/pkgIndex.tcl | 3 + .../lib_tcl8/tklib0.8/tkpiechart/relirect.tcl | 112 + .../lib_tcl8/tklib0.8/tkpiechart/selector.tcl | 166 + .../lib_tcl8/tklib0.8/tkpiechart/slice.tcl | 312 + .../tklib0.8/tkpiechart/tkpiechart.tcl | 15 + .../lib_tcl8/tklib0.8/tooltip/pkgIndex.tcl | 4 + .../lib_tcl8/tklib0.8/tooltip/tipstack.tcl | 169 + .../lib_tcl8/tklib0.8/tooltip/tooltip.tcl | 644 ++ .../lib_tcl8/tklib0.8/wcb/pkgIndex.tcl | 15 + .../lib_tcl8/tklib0.8/wcb/scripts/tclIndex | 47 + .../tklib0.8/wcb/scripts/wcbCommon.tcl | 482 + .../tklib0.8/wcb/scripts/wcbEntry.tcl | 339 + .../tklib0.8/wcb/scripts/wcbListbox.tcl | 70 + .../tklib0.8/wcb/scripts/wcbTablelist.tcl | 104 + .../lib_tcl8/tklib0.8/wcb/scripts/wcbText.tcl | 214 + .../tklib0.8/wcb/scripts/wcbTreeview.tcl | 87 + .../lib_tcl8/tklib0.8/wcb/wcb.tcl | 63 + .../lib_tcl8/tklib0.8/widget/arrowb.tcl | 126 + .../lib_tcl8/tklib0.8/widget/calendar.tcl | 702 ++ .../lib_tcl8/tklib0.8/widget/dateentry.tcl | 342 + .../lib_tcl8/tklib0.8/widget/dialog.tcl | 473 + .../lib_tcl8/tklib0.8/widget/mentry.tcl | 297 + .../lib_tcl8/tklib0.8/widget/panelframe.tcl | 244 + .../lib_tcl8/tklib0.8/widget/pkgIndex.tcl | 32 + .../lib_tcl8/tklib0.8/widget/ruler.tcl | 645 ++ .../lib_tcl8/tklib0.8/widget/scrollw.tcl | 258 + .../lib_tcl8/tklib0.8/widget/statusbar.tcl | 287 + .../lib_tcl8/tklib0.8/widget/stext.tcl | 77 + .../lib_tcl8/tklib0.8/widget/superframe.tcl | 140 + .../lib_tcl8/tklib0.8/widget/toolbar.tcl | 296 + .../lib_tcl8/tklib0.8/widget/widget.tcl | 162 + .../lib_tcl8/tklib0.8/widgetPlus/pkgIndex.tcl | 2 + .../tklib0.8/widgetPlus/widgetPlus.tcl | 1677 +++ .../lib_tcl8/tklib0.8/widgetl/listentry.tcl | 1192 ++ .../lib_tcl8/tklib0.8/widgetl/listsimple.tcl | 676 ++ .../lib_tcl8/tklib0.8/widgetl/pkgIndex.tcl | 3 + .../lib_tcl8/tklib0.8/widgetv/pkgIndex.tcl | 2 + .../lib_tcl8/tklib0.8/widgetv/validator.tcl | 422 + 228 files changed, 128781 insertions(+), 131 deletions(-) create mode 100644 src/bootsupport/lib/tar/ChangeLog create mode 100644 src/bootsupport/lib/tar/pkgIndex.tcl create mode 100644 src/bootsupport/lib/tar/tar.man create mode 100644 src/bootsupport/lib/tar/tar.pcx create mode 100644 src/bootsupport/lib/tar/tar.tcl create mode 100644 src/bootsupport/lib/tar/tar.test create mode 100644 src/bootsupport/lib/tar/tests/support.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/autoscroll/autoscroll.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/autoscroll/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/canvas_drag.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/canvas_ecircle.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/canvas_epoints.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/canvas_epolyline.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/canvas_equad.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/canvas_erectangle.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/canvas_gradient.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/canvas_highlight.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/canvas_mvg.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/canvas_snap.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/canvas_sqmap.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/canvas_tags.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/canvas_trlines.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/canvas_zoom.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/chatwidget/chatwidget.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/chatwidget/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/controlwidget/bindDown.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/controlwidget/controlwidget.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/controlwidget/led.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/controlwidget/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/controlwidget/radioMatrix.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/controlwidget/rdial.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/controlwidget/tachometer.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/controlwidget/vertical_meter.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/controlwidget/voltmeter.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/crosshair/crosshair.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/crosshair/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/ctext/ctext.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/ctext/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/cursor/cursor.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/cursor/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/datefield/datefield.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/datefield/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/diagrams/application.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/diagrams/attributes.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/diagrams/basic.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/diagrams/core.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/diagrams/diagram.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/diagrams/direction.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/diagrams/element.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/diagrams/navigation.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/diagrams/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/diagrams/point.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/getstring/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/getstring/tk_getString.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/history/history.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/history/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/ico/ico.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/ico/ico0.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/ico/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/ipentry/ipentry.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/ipentry/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/khim/ROOT.msg create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/khim/cs.msg create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/khim/da.msg create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/khim/de.msg create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/khim/en.msg create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/khim/es.msg create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/khim/khim.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/khim/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/khim/pl.msg create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/khim/ru.msg create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/khim/uk.msg create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/mentry/mentry.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/mentry/mentryCommon.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/mentry/mentry_tile.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/mentry/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/mentry/scripts/mentryDateTime.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/mentry/scripts/mentryFixedPoint.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/mentry/scripts/mentryIPAddr.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/mentry/scripts/mentryIPv6Addr.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/mentry/scripts/mentryThemes.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/mentry/scripts/mentryWidget.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/mentry/scripts/mwutil/mwutil.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/mentry/scripts/mwutil/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/mentry/scripts/tclIndex create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/menubar/debug.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/menubar/menubar.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/menubar/node.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/menubar/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/menubar/tree.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/notifywindow/notifywindow.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/notifywindow/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/ntext/ntext.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/ntext/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/persistentSelection/persistentSelection.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/persistentSelection/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plot3d.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plotanim.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plotannot.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plotaxis.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plotbind.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plotbusiness.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plotchart.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plotcombined.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plotconfig.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plotcontour.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plotdendrogram.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plotgantt.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plotobject.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plotpack.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plotpriv.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plotscada.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plotspecial.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plotstatustimeline.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/plottable.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/scaling.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/plotchart/xyplot.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scripts/attrib.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scripts/notebookImages.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scripts/pagesman.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scripts/plainnotebook.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scripts/scrollableframe.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scripts/scrollarea.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scripts/scrollednotebook.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scripts/scrollsync.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scripts/tclIndex create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scripts/utils/indicatorImgs/gifIndicatorImgs.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scripts/utils/indicatorImgs/svgIndicatorImgs.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scripts/utils/indicatorImgs/tclIndex create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scripts/utils/mwutil.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scripts/utils/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scripts/utils/scaleutil.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scripts/utils/themepatch.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scripts/wheelEvent.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scrollutil.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scrollutilCommon.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/scrollutil/scrollutil_tile.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/shtmlview/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/shtmlview/shtmlview-doctools.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/shtmlview/shtmlview-mkdoc.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/shtmlview/shtmlview.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/style/as.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/style/lobster.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/style/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/style/style.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/swaplist/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/swaplist/swaplist.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/pencil.cur create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/repair.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/tablelistBind.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/tablelistConfig.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/tablelistEdit.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/tablelistImages.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/tablelistMove.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/tablelistSort.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/tablelistThemes.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/tablelistUtil.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/tablelistWidget.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/tclIndex create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/utils/indicatorImgs/gifIndicatorImgs.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/utils/indicatorImgs/svgIndicatorImgs.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/utils/indicatorImgs/tclIndex create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/utils/mwutil.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/utils/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/utils/scaleutil.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/utils/scaleutilMisc.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/scripts/utils/themepatch.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/tablelist.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/tablelistCommon.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tablelist/tablelist_tile.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tkpiechart/boxlabel.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tkpiechart/canlabel.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tkpiechart/labarray.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tkpiechart/objselec.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tkpiechart/perilabel.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tkpiechart/pie.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tkpiechart/pielabel.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tkpiechart/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tkpiechart/relirect.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tkpiechart/selector.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tkpiechart/slice.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tkpiechart/tkpiechart.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tooltip/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tooltip/tipstack.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/tooltip/tooltip.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/wcb/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/wcb/scripts/tclIndex create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/wcb/scripts/wcbCommon.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/wcb/scripts/wcbEntry.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/wcb/scripts/wcbListbox.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/wcb/scripts/wcbTablelist.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/wcb/scripts/wcbText.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/wcb/scripts/wcbTreeview.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/wcb/wcb.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widget/arrowb.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widget/calendar.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widget/dateentry.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widget/dialog.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widget/mentry.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widget/panelframe.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widget/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widget/ruler.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widget/scrollw.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widget/statusbar.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widget/stext.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widget/superframe.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widget/toolbar.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widget/widget.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widgetPlus/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widgetPlus/widgetPlus.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widgetl/listentry.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widgetl/listsimple.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widgetl/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widgetv/pkgIndex.tcl create mode 100644 src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/widgetv/validator.tcl diff --git a/src/bootsupport/lib/tar/ChangeLog b/src/bootsupport/lib/tar/ChangeLog new file mode 100644 index 00000000..89a34bb0 --- /dev/null +++ b/src/bootsupport/lib/tar/ChangeLog @@ -0,0 +1,186 @@ +2013-11-22 Andreas Kupries + + * tar.man: Reviewed the work on the pyk-tar branch. Brought + * tar.tcl: new testsuite up to spec. Reviewed the skip fix, + * tar.test: modified it to reinstate the skip limit per round + * test-support.tcl: without getting the bug back. Bumped version + to 0.9. Thanks to PoorYorick for the initial work on the bug, + fix, and testsuite. This also fixes ticket [6b7aa0aecc]. + +2013-08-12 Andreas Kupries + + * tar.man (tar::untar, contents, stat, get): Extended the + * tar.tcl: procedures to detect and properly handle @LongName + * pkgIndex.tcl: header entries as generated by GNU tar. These + entries contain the file name for the next header entry as file + data, for files whose name is longer than the 100-char field of + the regular header. Version bumped to 0.8. This is a new + feature. + +2013-02-01 Andreas Kupries + + * + * Released and tagged Tcllib 1.15 ======================== + * + +2012-09-11 Andreas Kupries + + * tar.tcl (seekorskip): Fixed seekorskip which prevented its use + * pkgIndex.tcl: from a non-seekable channel, like stdin. The issue + was that the original attempt to seek before skipping not just + failed, but apparently still moved the read pointer in some way + which skipped over irreplacable input, breaking the next call of + readHeader. Using [tell] to check seekability does not break in + this manner. Bumped version to 0.7.1. + +2011-12-13 Andreas Kupries + + * + * Released and tagged Tcllib 1.14 ======================== + * + +2011-01-24 Andreas Kupries + + * + * Released and tagged Tcllib 1.13 ======================== + * + +2011-01-20 Andreas Kupries + + * tar.tcl: [Bug 3162548]: Applied patch by Alexandre Ferrieux, + * tar.man: extending various tar commands to be able to use + * pkgIndex.tcl: the -chan option, and channels instead of files. + Version bumped to 0.7 + +2009-12-07 Andreas Kupries + + * + * Released and tagged Tcllib 1.12 ======================== + * + +2009-12-03 Andreas Kupries + + * tar.man: [Patch 2840147]. Applied. New options -prefix and + * tar.tcl: -quick for tar::add. -prefix allows specifying a + * tar.pcx: prefix for filenames in the archive, and -quick 1 + * pkgIndex.tcl: changes back to the seek-from-end algorithm for + finding the place where to add the new files. The new default + scans from start (robust). Bumped version to 0.6. + +2009-05-12 Aaron Faupell + + * tar.tcl: add support for reading pre-posix archives. + if a file isnt writable when extracting, try deleting + before giving up. + +2008-12-12 Andreas Kupries + + * + * Released and tagged Tcllib 1.11.1 ======================== + * + +2008-11-26 Aaron Faupell + + * tar.man: add and clarify documentation + +2008-10-16 Andreas Kupries + + * + * Released and tagged Tcllib 1.11 ======================== + * + +2008-06-14 Andreas Kupries + + * tar.pcx: New file. Syntax definitions for the public commands of + the tar package. + +2007-09-12 Andreas Kupries + + * + * Released and tagged Tcllib 1.10 ======================== + * + +2007-03-21 Andreas Kupries + + * tar.man: Fixed all warnings due to use of now deprecated + commands. Added a section about how to give feedback. + +2007-02-08 Aaron Faupell + + * tar.tcl: bug fix in recursion algorithm that missed + some files in deep subdirs. incremented version + +2007-01-08 Andreas Kupries + + * tar.tcl: Bumped version to 0.3, for the bugfix described + * tar.man: by the last entry. + * pkgIndex.tcl: + +2006-12-20 Aaron Faupell + + * tar.tcl: fix in parseOpts which affected -file and -glob + arguments to tar::untar + * tar.man: clarifications to add, create, and untar + +2006-10-03 Andreas Kupries + + * + * Released and tagged Tcllib 1.9 ======================== + * + +2006-29-06 Aaron Faupell + + * tar.tcl: fixed bug in parseOpts + +2005-11-08 Andreas Kupries + + * pkgIndex.tcl: Corrected buggy commit, synchronized version + * tar.man: numbers across all relevant files. + +2005-11-08 Aaron Faupell + + * tar.tcl: bumped version to 0.2 because of new feature + * tar.man: tar::remove + +2005-11-07 Andreas Kupries + + * tar.man: Fixed error, incorrect placement of [call] markup + outside of list. + +2005-11-04 Aaron Faupell + + * tar.man: added tar::remove command and documentation for it + * tar.tcl: + +2005-10-06 Andreas Kupries + + * + * Released and tagged Tcllib 1.8 ======================== + * + +2005-09-30 Andreas Kupries + + * tar.tcl: qualified all [open] calls with :: to ensure usag of + the builtin. Apparently mitigates conflict between this package + and the vfs::tar module. + +2004-10-05 Andreas Kupries + + * + * Released and tagged Tcllib 1.7 ======================== + * + +2004-10-02 Andreas Kupries + + * tar.man: Added keywords and title/module description to the + documentation. + +2004-09-10 Aaron Faupell + + * tar.tcl: Fixed typo bug in ::tar::add + * tar.man: Added info for ::tar::stat + +2004-08-23 Andreas Kupries + + * tar.man: Fixed problems in the documentation. + diff --git a/src/bootsupport/lib/tar/pkgIndex.tcl b/src/bootsupport/lib/tar/pkgIndex.tcl new file mode 100644 index 00000000..48836471 --- /dev/null +++ b/src/bootsupport/lib/tar/pkgIndex.tcl @@ -0,0 +1,5 @@ +if {![package vsatisfies [package provide Tcl] 8.5 9]} { + # PRAGMA: returnok + return +} +package ifneeded tar 0.12 [list source [file join $dir tar.tcl]] diff --git a/src/bootsupport/lib/tar/tar.man b/src/bootsupport/lib/tar/tar.man new file mode 100644 index 00000000..5b406f82 --- /dev/null +++ b/src/bootsupport/lib/tar/tar.man @@ -0,0 +1,202 @@ +[comment {-*- mode: tcl ; fill-column: 80 -*- doctools manpage}] +[vset PACKAGE_VERSION 0.12] +[manpage_begin tar n [vset PACKAGE_VERSION]] +[keywords archive] +[keywords {tape archive}] +[keywords tar] +[moddesc {Tar file handling}] +[titledesc {Tar file creation, extraction & manipulation}] +[category {File formats}] +[require Tcl "8.5 9"] +[require tar [opt [vset PACKAGE_VERSION]]] +[description] + +[para] [strong Note]: Starting with version 0.8 the tar reader commands +(contents, stats, get, untar) support the GNU LongName extension (header type +'L') for large paths. + +[para] + +[section BEWARE] + +For all commands, when using [option -chan] ... + +[list_begin enumerated] + +[enum] It is assumed that the channel was opened for reading, and configured for + binary input. + +[enum] It is assumed that the channel position is at the beginning of a legal + tar file. + +[enum] The commands will [emph modify] the channel position as they perform their + task. + +[enum] The commands will [emph not] close the channel. + +[enum] In other words, the commands leave the channel in a state very likely + unsuitable for use by further [cmd tar] commands. Still doing so will + very likely results in errors, bad data, etc. pp. + +[enum] It is the responsibility of the user to seek the channel back to a + suitable position. + +[enum] When using a channel transformation which is not generally seekable, for + example [cmd gunzip], then it is the responsibility of the user to (a) + unstack the transformation before seeking the channel back to a suitable + position, and (b) for restacking it after. + +[list_end] + +[section COMMANDS] + +[list_begin definitions] + +[call [cmd ::tar::contents] [arg tarball] [opt [option -chan]]] + +Returns a list of the files contained in [arg tarball]. The order is not sorted and depends on the order +files were stored in the archive. +[para] + +If the option [option -chan] is present [arg tarball] is interpreted as an open channel. +It is assumed that the channel was opened for reading, and configured for binary input. +The command will [emph not] close the channel. + +[call [cmd ::tar::stat] [arg tarball] [opt file] [opt [option -chan]]] + +Returns a nested dict containing information on the named [opt file] in [arg tarball], +or all files if none is specified. The top level are pairs of filename and info. The info is a dict with the keys +"[const mode] [const uid] [const gid] [const size] [const mtime] [const type] [const linkname] [const uname] [const gname] + [const devmajor] [const devminor]" + +[example { +% ::tar::stat tarball.tar +foo.jpg {mode 0644 uid 1000 gid 0 size 7580 mtime 811903867 type file linkname {} uname user gname wheel devmajor 0 devminor 0} +}] + +[para] +If the option [option -chan] is present [arg tarball] is interpreted as an open channel. +It is assumed that the channel was opened for reading, and configured for binary input. +The command will [emph not] close the channel. + +[call [cmd ::tar::untar] [arg tarball] [arg args]] + +Extracts [arg tarball]. [arg -file] and [arg -glob] limit the extraction +to files which exactly match or pattern match the given argument. No error is +thrown if no files match. Returns a list of filenames extracted and the file +size. The size will be null for non regular files. Leading path seperators are +stripped so paths will always be relative. + +[list_begin options] +[opt_def -dir dirName] +Directory to extract to. Uses [cmd pwd] if none is specified +[opt_def -file fileName] +Only extract the file with this name. The name is matched against the complete path +stored in the archive including directories. +[opt_def -glob pattern] +Only extract files patching this glob style pattern. The pattern is matched against the complete path +stored in the archive. +[opt_def -nooverwrite] +Dont overwrite files that already exist +[opt_def -nomtime] +Leave the file modification time as the current time instead of setting it to the value in the archive. +[opt_def -noperms] +In Unix, leave the file permissions as the current umask instead of setting them to the values in the archive. + +[opt_def -chan] +If this option is present [arg tarball] is interpreted as an open channel. +It is assumed that the channel was opened for reading, and configured for binary input. +The command will [emph not] close the channel. + +[list_end] +[para] + +[example { +% foreach {file size} [::tar::untar tarball.tar -glob *.jpg] { +puts "Extracted $file ($size bytes)" +} +}] + +[call [cmd ::tar::get] [arg tarball] [arg fileName] [opt [option -chan]]] + +Returns the contents of [arg fileName] from the [arg tarball]. + +[para][example { +% set readme [::tar::get tarball.tar doc/README] { +% puts $readme +} +}] + +[para] If the option [option -chan] is present [arg tarball] is +interpreted as an open channel. It is assumed that the channel was +opened for reading, and configured for binary input. The command will +[emph not] close the channel. + +[para] An error is thrown when [arg fileName] is not found in the tar +archive. + +[call [cmd ::tar::create] [arg tarball] [arg files] [arg args]] + +Creates a new tar file containing the [arg files]. [arg files] must be specified +as a single argument which is a proper list of filenames. + +[list_begin options] +[opt_def -dereference] +Normally [cmd create] will store links as an actual link pointing at a file that may +or may not exist in the archive. Specifying this option will cause the actual file point to + by the link to be stored instead. + +[opt_def -chan] +If this option is present [arg tarball] is interpreted as an open channel. +It is assumed that the channel was opened for writing, and configured for binary output. +The command will [emph not] close the channel. + +[list_end] +[para] + +[example { +% ::tar::create new.tar [glob -nocomplain file*] +% ::tar::contents new.tar +file1 file2 file3 +}] + +[call [cmd ::tar::add] [arg tarball] [arg files] [arg args]] + +Appends [arg files] to the end of the existing [arg tarball]. [arg files] must be specified +as a single argument which is a proper list of filenames. + +[list_begin options] +[opt_def -dereference] +Normally [cmd add] will store links as an actual link pointing at a file that may +or may not exist in the archive. Specifying this option will cause the actual file point to + by the link to be stored instead. +[opt_def -prefix string] +Normally [cmd add] will store files under exactly the name specified as +argument. Specifying a [opt -prefix] causes the [arg string] to be +prepended to every name. +[opt_def -quick] +The only sure way to find the position in the [arg tarball] where new +files can be added is to read it from start, but if [arg tarball] was +written with a "blocksize" of 1 (as this package does) then one can +alternatively find this position by seeking from the end. The +[opt -quick] option tells [cmd add] to do the latter. +[list_end] +[para] + +[call [cmd ::tar::remove] [arg tarball] [arg files]] + +Removes [arg files] from the [arg tarball]. No error will result if the file does not exist in the +tarball. Directory write permission and free disk space equivalent to at least the size of the tarball +will be needed. + +[example { +% ::tar::remove new.tar {file2 file3} +% ::tar::contents new.tar +file3 +}] + +[list_end] + +[vset CATEGORY tar] +[include ../common-text/feedback.inc] +[manpage_end] diff --git a/src/bootsupport/lib/tar/tar.pcx b/src/bootsupport/lib/tar/tar.pcx new file mode 100644 index 00000000..59e008a9 --- /dev/null +++ b/src/bootsupport/lib/tar/tar.pcx @@ -0,0 +1,83 @@ +# -*- tcl -*- tar.pcx +# Syntax of the commands provided by package tar. +# +# For use by TclDevKit's static syntax checker (v4.1+). +# See http://www.activestate.com/solutions/tcl/ +# See http://aspn.activestate.com/ASPN/docs/Tcl_Dev_Kit/4.0/Checker.html#pcx_api +# for the specification of the format of the code in this file. +# + +package require pcx +pcx::register tar +pcx::tcldep 0.4 needs tcl 8.2 +pcx::tcldep 0.5 needs tcl 8.2 +pcx::tcldep 0.6 needs tcl 8.2 + +namespace eval ::tar {} + +#pcx::message FOO {... text ...} type +#pcx::scan + +pcx::check 0.4 std ::tar::add \ + {checkSimpleArgs 2 -1 { + checkFileName + {checkListValues 1 -1 checkFileName} + {checkSwitches 1 { + {-dereference checkBoolean} + } {}} + }} +pcx::check 0.6 std ::tar::add \ + {checkSimpleArgs 2 -1 { + checkFileName + {checkListValues 1 -1 checkFileName} + {checkSwitches 1 { + {-dereference checkBoolean} + {-quick checkBoolean} + {-prefix checkWord} + } {}} + }} +pcx::check 0.4 std ::tar::contents \ + {checkSimpleArgs 1 1 { + checkFileName + }} +pcx::check 0.4 std ::tar::create \ + {checkSimpleArgs 2 -1 { + checkFileName + {checkListValues 1 -1 checkFileName} + {checkSwitches 1 { + {-chan checkChannelID} + {-dereference checkBoolean} + } {}} + }} +pcx::check 0.4 std ::tar::get \ + {checkSimpleArgs 2 2 { + checkFileName + checkFileName + }} +pcx::check 0.4 std ::tar::remove \ + {checkSimpleArgs 2 2 { + checkFileName + {checkListValues 1 -1 checkFileName} + }} +pcx::check 0.4 std ::tar::stat \ + {checkSimpleArgs 1 2 { + checkFileName + checkFileName + }} +pcx::check 0.4 std ::tar::untar \ + {checkSimpleArgs 1 -1 { + checkFileName + {checkSwitches 1 { + {-chan checkChannelID} + {-dir checkFileName} + {-file checkFileName} + {-glob checkPattern} + {-nomtime checkBoolean} + {-nooverwrite checkBoolean} + {-noperms checkBoolean} + } {}} + }} + +# Initialization via pcx::init. +# Use a ::tar::init procedure for non-standard initialization. +pcx::complete diff --git a/src/bootsupport/lib/tar/tar.tcl b/src/bootsupport/lib/tar/tar.tcl new file mode 100644 index 00000000..eaff6425 --- /dev/null +++ b/src/bootsupport/lib/tar/tar.tcl @@ -0,0 +1,550 @@ +# tar.tcl -- +# +# Creating, extracting, and listing posix tar archives +# +# Copyright (c) 2004 Aaron Faupell +# Copyright (c) 2013 Andreas Kupries +# (GNU tar @LongLink support). +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: tar.tcl,v 1.17 2012/09/11 17:22:24 andreas_kupries Exp $ + +package require Tcl 8.5 9 +package provide tar 0.12 + +namespace eval ::tar {} + +proc ::tar::parseOpts {acc opts} { + array set flags $acc + foreach {x y} $acc {upvar $x $x} + + set len [llength $opts] + set i 0 + while {$i < $len} { + set name [string trimleft [lindex $opts $i] -] + if {![info exists flags($name)]} { + return -errorcode {TAR INVALID OPTION} \ + -code error "unknown option \"$name\"" + } + if {$flags($name) == 1} { + set $name [lindex $opts [expr {$i + 1}]] + incr i $flags($name) + } elseif {$flags($name) > 1} { + set $name [lrange $opts [expr {$i + 1}] [expr {$i + $flags($name)}]] + incr i $flags($name) + } else { + set $name 1 + } + incr i + } +} + +proc ::tar::pad {size} { + set pad [expr {512 - ($size % 512)}] + if {$pad == 512} {return 0} + return $pad +} + +proc ::tar::seekorskip {ch off wh} { + if {[tell $ch] < 0} { + if {$wh!="current"} { + return -code error -errorcode [list TAR INVALID WHENCE $wh] \ + "WHENCE=$wh not supported on non-seekable channel $ch" + } + skip $ch $off + return + } + seek $ch $off $wh + return +} + +proc ::tar::skip {ch skipover} { + while {$skipover > 0} { + set requested $skipover + + # Limit individual skips to 64K, as a compromise between speed + # of skipping (Number of read requests), and memory usage + # (Note how skipped block is read into memory!). While the + # read data is immediately discarded it still generates memory + # allocation traffic, gets copied, etc. Trying to skip the + # block in one go without the limit may cause us to run out of + # (virtual) memory, or just induce swapping, for nothing. + + if {$requested > 65536} { + set requested 65536 + } + + set skipped [string length [read $ch $requested]] + + # Stop in short read into the end of the file. + if {!$skipped && [eof $ch]} break + + # Keep track of how much is (not) skipped yet. + incr skipover -$skipped + } + return +} + +proc ::tar::readHeader {data} { + binary scan $data a100a8a8a8a12a12a8a1a100a6a2a32a32a8a8a155 \ + name mode uid gid size mtime cksum type \ + linkname magic version uname gname devmajor devminor prefix + + foreach x {name type linkname} { + set $x [string trim [set $x] "\x00"] + } + foreach x {uid gid size mtime cksum} { + set $x [format %d 0[string trim [set $x] " \x00"]] + } + set mode [string trim $mode " \x00"] + + if {$magic == "ustar "} { + # gnu tar + # not fully supported + foreach x {uname gname prefix} { + set $x [string trim [set $x] "\x00"] + } + foreach x {devmajor devminor} { + set $x [format %d 0[string trim [set $x] " \x00"]] + } + } elseif {$magic == "ustar\x00"} { + # posix tar + foreach x {uname gname prefix} { + set $x [string trim [set $x] "\x00"] + } + foreach x {devmajor devminor} { + set $x [format %d 0[string trim [set $x] " \x00"]] + } + } else { + # old style tar + foreach x {uname gname devmajor devminor prefix} { set $x {} } + if {$type == ""} { + if {[string match */ $name]} { + set type 5 + } else { + set type 0 + } + } + } + + return [list name $name mode $mode uid $uid gid $gid size $size mtime $mtime \ + cksum $cksum type $type linkname $linkname magic $magic \ + version $version uname $uname gname $gname devmajor $devmajor \ + devminor $devminor prefix $prefix] +} + +proc ::tar::contents {file args} { + set chan 0 + parseOpts {chan 0} $args + if {$chan} { + set fh $file + } else { + set fh [::open $file] + fconfigure $fh -encoding binary -translation lf -eofchar {} + } + set ret {} + while {![eof $fh]} { + array set header [readHeader [read $fh 512]] + HandleLongLink $fh header + if {$header(name) == ""} break + if {$header(prefix) != ""} {append header(prefix) /} + lappend ret $header(prefix)$header(name) + seekorskip $fh [expr {$header(size) + [pad $header(size)]}] current + } + if {!$chan} { + close $fh + } + return $ret +} + +proc ::tar::stat {tar {file {}} args} { + set chan 0 + parseOpts {chan 0} $args + if {$chan} { + set fh $tar + } else { + set fh [::open $tar] + fconfigure $fh -encoding binary -translation lf -eofchar {} + } + set ret {} + while {![eof $fh]} { + array set header [readHeader [read $fh 512]] + HandleLongLink $fh header + if {$header(name) == ""} break + if {$header(prefix) != ""} {append header(prefix) /} + seekorskip $fh [expr {$header(size) + [pad $header(size)]}] current + if {$file != "" && "$header(prefix)$header(name)" != $file} {continue} + set header(type) [string map {0 file 5 directory 3 characterSpecial 4 blockSpecial 6 fifo 2 link} $header(type)] + set header(mode) [string range $header(mode) 2 end] + lappend ret $header(prefix)$header(name) [list mode $header(mode) uid $header(uid) gid $header(gid) \ + size $header(size) mtime $header(mtime) type $header(type) linkname $header(linkname) \ + uname $header(uname) gname $header(gname) devmajor $header(devmajor) devminor $header(devminor)] + } + if {!$chan} { + close $fh + } + return $ret +} + +proc ::tar::get {tar file args} { + set chan 0 + parseOpts {chan 0} $args + if {$chan} { + set fh $tar + } else { + set fh [::open $tar] + fconfigure $fh -encoding binary -translation lf -eofchar {} + } + while {![eof $fh]} { + set data [read $fh 512] + array set header [readHeader $data] + HandleLongLink $fh header + if {$header(name) eq ""} break + if {$header(prefix) ne ""} {append header(prefix) /} + set name [string trimleft $header(prefix)$header(name) /] + if {$name eq $file} { + set file [read $fh $header(size)] + if {!$chan} { + close $fh + } + return $file + } + seekorskip $fh [expr {$header(size) + [pad $header(size)]}] current + } + if {!$chan} { + close $fh + } + return -code error -errorcode {TAR MISSING FILE} \ + "Tar \"$tar\": File \"$file\" not found" +} + +proc ::tar::untar {tar args} { + set nooverwrite 0 + set data 0 + set nomtime 0 + set noperms 0 + set chan 0 + parseOpts {dir 1 file 1 glob 1 nooverwrite 0 nomtime 0 noperms 0 chan 0} $args + if {![info exists dir]} {set dir [pwd]} + set pattern * + if {[info exists file]} { + set pattern [string map {* \\* ? \\? \\ \\\\ \[ \\\[ \] \\\]} $file] + } elseif {[info exists glob]} { + set pattern $glob + } + + set ret {} + if {$chan} { + set fh $tar + } else { + set fh [::open $tar] + fconfigure $fh -encoding binary -translation lf -eofchar {} + } + while {![eof $fh]} { + array set header [readHeader [read $fh 512]] + HandleLongLink $fh header + if {$header(name) == ""} break + if {$header(prefix) != ""} {append header(prefix) /} + set name [string trimleft $header(prefix)$header(name) /] + if {![string match $pattern $name] || ($nooverwrite && [file exists $name])} { + seekorskip $fh [expr {$header(size) + [pad $header(size)]}] current + continue + } + + set name [file join $dir $name] + if {![file isdirectory [file dirname $name]]} { + file mkdir [file dirname $name] + lappend ret [file dirname $name] {} + } + if {[string match {[0346]} $header(type)]} { + if {[catch {::open $name w+} new]} { + # sometimes if we dont have write permission we can still delete + catch {file delete -force $name} + set new [::open $name w+] + } + fconfigure $new -encoding binary -translation lf -eofchar {} + fcopy $fh $new -size $header(size) + close $new + lappend ret $name $header(size) + } elseif {$header(type) == 5} { + file mkdir $name + lappend ret $name {} + } elseif {[string match {[12]} $header(type)] && $::tcl_platform(platform) == "unix"} { + catch {file delete $name} + if {![catch {file link [string map {1 -hard 2 -symbolic} $header(type)] $name $header(linkname)}]} { + lappend ret $name {} + } + } + seekorskip $fh [pad $header(size)] current + if {![file exists $name]} continue + + if {$::tcl_platform(platform) == "unix"} { + if {!$noperms} { + catch {file attributes $name -permissions 0o[string range $header(mode) 2 end]} + } + catch {file attributes $name -owner $header(uid) -group $header(gid)} + catch {file attributes $name -owner $header(uname) -group $header(gname)} + } + if {!$nomtime} { + file mtime $name $header(mtime) + } + } + if {!$chan} { + close $fh + } + return $ret +} + +## + # ::tar::statFile + # + # Returns stat info about a filesystem object, in the form of an info + # dictionary like that returned by ::tar::readHeader. + # + # The mode, uid, gid, mtime, and type entries are always present. + # The size and linkname entries are present if relevant for this type + # of object. The uname and gname entries are present if the OS supports + # them. No devmajor or devminor entry is present. + ## + +proc ::tar::statFile {name followlinks} { + if {$followlinks} { + file stat $name stat + } else { + file lstat $name stat + } + + set ret {} + + if {$::tcl_platform(platform) == "unix"} { + # Tcl 9 returns the permission as 0o octal number. Since this + # is written to the tar file and the file format expects "00" + # we have to rewrite. + lappend ret mode 1[string map {o 0} [file attributes $name -permissions]] + lappend ret uname [file attributes $name -owner] + lappend ret gname [file attributes $name -group] + if {$stat(type) == "link"} { + lappend ret linkname [file link $name] + } + } else { + lappend ret mode [lindex {100644 100755} [expr {$stat(type) == "directory"}]] + } + + lappend ret uid $stat(uid) gid $stat(gid) mtime $stat(mtime) \ + type $stat(type) + + if {$stat(type) == "file"} {lappend ret size $stat(size)} + + return $ret +} + +## + # ::tar::formatHeader + # + # Opposite operation to ::tar::readHeader; takes a file name and info + # dictionary as arguments, returns a corresponding (POSIX-tar) header. + # + # The following dictionary entries must be present: + # mode + # type + # + # The following dictionary entries are used if present, otherwise + # the indicated default is used: + # uid 0 + # gid 0 + # size 0 + # mtime [clock seconds] + # linkname {} + # uname {} + # gname {} + # + # All other dictionary entries, including devmajor and devminor, are + # presently ignored. + ## + +proc ::tar::formatHeader {name info} { + array set A { + linkname "" + uname "" + gname "" + size 0 + gid 0 + uid 0 + } + set A(mtime) [clock seconds] + array set A $info + array set A {devmajor "" devminor ""} + + set type [string map {file 0 directory 5 characterSpecial 3 \ + blockSpecial 4 fifo 6 link 2 socket A} $A(type)] + + set osize [format %o $A(size)] + set ogid [format %o $A(gid)] + set ouid [format %o $A(uid)] + set omtime [format %o $A(mtime)] + + set name [string trimleft $name /] + if {[string length $name] > 255} { + return -code error -errorcode {TAR BAD PATH LENGTH} \ + "path name over 255 chars" + } elseif {[string length $name] > 100} { + set common [string range $name end-99 154] + if {[set splitpoint [string first / $common]] == -1} { + return -code error -errorcode {TAR BAD PATH UNSPLITTABLE} \ + "path name cannot be split into prefix and name" + } + set prefix [string range $name 0 end-100][string range $common 0 $splitpoint-1] + set name [string range $common $splitpoint+1 end][string range $name 155 end] + } else { + set prefix "" + } + + set header [binary format a100A8A8A8A12A12A8a1a100A6a2a32a32a8a8a155a12 \ + $name $A(mode)\x00 $ouid\x00 $ogid\x00\ + $osize\x00 $omtime\x00 {} $type \ + $A(linkname) ustar\x00 00 $A(uname) $A(gname)\ + $A(devmajor) $A(devminor) $prefix {}] + + binary scan $header c* tmp + set cksum 0 + foreach x $tmp {incr cksum $x} + + return [string replace $header 148 155 [binary format A8 [format %o $cksum]\x00]] +} + + +proc ::tar::recurseDirs {files followlinks} { + foreach x $files { + if {[file isdirectory $x] && ([file type $x] != "link" || $followlinks)} { + if {[set more [glob -dir $x -nocomplain *]] != ""} { + eval lappend files [recurseDirs $more $followlinks] + } else { + lappend files $x + } + } + } + return $files +} + +proc ::tar::writefile {in out followlinks name} { + puts -nonewline $out [formatHeader $name [statFile $in $followlinks]] + set size 0 + if {[file type $in] == "file" || ($followlinks && [file type $in] == "link")} { + set in [::open $in] + fconfigure $in -encoding binary -translation lf -eofchar {} + set size [fcopy $in $out] + close $in + } + puts -nonewline $out [string repeat \x00 [pad $size]] +} + +proc ::tar::create {tar files args} { + set dereference 0 + set chan 0 + parseOpts {dereference 0 chan 0} $args + + if {$chan} { + set fh $tar + } else { + set fh [::open $tar w+] + fconfigure $fh -encoding binary -translation lf -eofchar {} + } + foreach x [recurseDirs $files $dereference] { + writefile $x $fh $dereference $x + } + puts -nonewline $fh [string repeat \x00 1024] + + if {!$chan} { + close $fh + } + return $tar +} + +proc ::tar::add {tar files args} { + set dereference 0 + set prefix "" + set quick 0 + parseOpts {dereference 0 prefix 1 quick 0} $args + + set fh [::open $tar r+] + fconfigure $fh -encoding binary -translation lf -eofchar {} + + if {$quick} then { + seek $fh -1024 end + } else { + set data [read $fh 512] + while {[regexp {[^\0]} $data]} { + array set header [readHeader $data] + seek $fh [expr {$header(size) + [pad $header(size)]}] current + set data [read $fh 512] + } + seek $fh -512 current + } + + foreach x [recurseDirs $files $dereference] { + writefile $x $fh $dereference $prefix$x + } + puts -nonewline $fh [string repeat \x00 1024] + + close $fh + return $tar +} + +proc ::tar::remove {tar files} { + set n 0 + while {[file exists $tar$n.tmp]} {incr n} + set tfh [::open $tar$n.tmp w] + set fh [::open $tar r] + + fconfigure $fh -encoding binary -translation lf -eofchar {} + fconfigure $tfh -encoding binary -translation lf -eofchar {} + + while {![eof $fh]} { + array set header [readHeader [read $fh 512]] + if {$header(name) == ""} { + puts -nonewline $tfh [string repeat \x00 1024] + break + } + if {$header(prefix) != ""} {append header(prefix) /} + set name $header(prefix)$header(name) + set len [expr {$header(size) + [pad $header(size)]}] + if {[lsearch $files $name] > -1} { + seek $fh $len current + } else { + seek $fh -512 current + fcopy $fh $tfh -size [expr {$len + 512}] + } + } + + close $fh + close $tfh + + file rename -force $tar$n.tmp $tar +} + +proc ::tar::HandleLongLink {fh hv} { + upvar 1 $hv header thelongname thelongname + + # @LongName Part I. + if {$header(type) == "L"} { + # Size == Length of name. Read it, and pad to full 512 + # size. After that is a regular header for the actual + # file, where we have to insert the name. This is handled + # by the next iteration and the part II below. + set thelongname [string trimright [read $fh $header(size)] \000] + seekorskip $fh [pad $header(size)] current + return -code continue + } + # Not supported yet: type 'K' for LongLink (long symbolic links). + + # @LongName, part II, get data from previous entry, if defined. + if {[info exists thelongname]} { + set header(name) $thelongname + # Prevent leakage to further entries. + unset thelongname + } + + return +} diff --git a/src/bootsupport/lib/tar/tar.test b/src/bootsupport/lib/tar/tar.test new file mode 100644 index 00000000..bc31128b --- /dev/null +++ b/src/bootsupport/lib/tar/tar.test @@ -0,0 +1,139 @@ +# -*- tcl -*- +# These tests are in the public domain +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file normalize [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.5 ; # Virt channel support! +testsNeedTcltest 1.0 + +# Check if we have TclOO available. +tcltest::testConstraint tcloo [expr {![catch {package require TclOO}]}] + +support { + if {[tcltest::testConstraint tcloo]} { + use virtchannel_base/memchan.tcl tcl::chan::memchan + } + useLocalFile tests/support.tcl +} +testing { + useLocal tar.tcl tar +} + +# ------------------------------------------------------------------------- + +test tar-stream {stream} -constraints tcloo -setup { + setup1 +} -body { + string length [read $chan1] +} -cleanup { + cleanup1 +} -result 128000 + +test tar-pad {pad} -body { + tar::pad 230 +} -result {282} + +test tar-skip {skip} -constraints tcloo -setup { + setup1 +} -body { + tar::skip $chan1 10 + lappend res [read $chan1 10] + tar::skip $chan1 72313 + lappend res [read $chan1 10] +} -cleanup { + cleanup1 +} -result {{6 7 8 9 10} {07 13908 1}} + +test tar-seekorskip-backwards {seekorskip} -constraints tcl8.6plus -setup setup1 -body { + # The zlib push stuff is Tcl 8.6+. Properly restrict the test. + zlib push gzip $chan1 + catch {tar::seekorskip $chan1 -10 start} cres + lappend res $cres + catch {tar::seekorskip $chan1 10 start} cres + lappend res $cres + catch {tar::seekorskip $chan1 -10 end} cres + lappend res $cres + catch {tar::seekorskip $chan1 10 end} cres + lappend res $cres + lappend res [read $chan1 10] +} -cleanup cleanup1 -match glob \ + -result [list \ + {WHENCE=start not supported*} \ + {WHENCE=start not supported*} \ + {WHENCE=end not supported*} \ + {WHENCE=end not supported*} \ + {1 2 3 4 5 } \ + ] + +test tar-header {header} -body { + set file1 [dict get $filesys Dir1 File1] + dict set file1 path /Dir1/File1 + set header [header_posix $file1] + set parsed [string trim [tar::readHeader $header]] + set golden "name /Dir1/File1 mode 755 uid 13103 gid 18103 size 100 mtime 5706756101 cksum 3676 type 0 linkname {} magic ustar\0 version 00 uname {} gname {} devmajor 0 devminor 0 prefix {}" + set len [string length $parsed] + foreach {key value} $golden { + if {[set value1 [dict get $parsed $key]] ne $value } { + lappend res [list $key $value $value1] + } + } +} -result {} + +test tar-add {add} -constraints tcloo -setup { + setup1 +} -body { + tar::create $chan1 [list $tmpdir/one/a $tmpdir/one/two/a $tmpdir/one/three/a] -chan + seek $chan1 0 + lappend res {*}[tar::contents $chan1 -chan] + seek $chan1 0 + lappend res [string trim [tar::get $chan1 $tmpdir/one/two/a -chan]] +} -cleanup { + cleanup1 +} -result {tartest/one/a tartest/one/two/a tartest/one/three/a hello2} + + +test tar-bug-2840180 {Ticket 2840180} -setup { + setup2 +} -body { + tar::create $chan1 [list $tmpdir/[large-path]/a] -chan + seek $chan1 0 + + # What the package sees. + lappend res {*}[tar::contents $chan1 -chan] + close $chan1 + + # What a regular tar package sees. + lappend res [exec 2> $tmpfile.err tar tvf $tmpfile] + join $res \n +} -cleanup { + cleanup2 +} -match glob -result [join [list \ + tartest/[large-path]/a \ + "* tartest/[large-path]/a" \ + ] \n] + +# ------------------------------------------------------------------------- + +test tar-tkt-9f4c0e3e95-1.0 {Ticket 9f4c0e3e95, A} -setup { + set tarfile [setup-tkt-9f4c0e3e95] +} -body { + string trim [tar::get $tarfile 02] +} -cleanup { + cleanup-tkt-9f4c0e3e95 + unset tarfile +} -result {zero-two} + +test tar-tkt-9f4c0e3e95-1.1 {Ticket 9f4c0e3e95, B, } -setup { + set tarfile [setup-tkt-9f4c0e3e95] +} -body { + tar::get $tarfile 0b10 +} -cleanup { + cleanup-tkt-9f4c0e3e95 + unset tarfile +} -returnCodes error -result {Tar "tartest/t.tar": File "0b10" not found} + +# ------------------------------------------------------------------------- +testsuiteCleanup diff --git a/src/bootsupport/lib/tar/tests/support.tcl b/src/bootsupport/lib/tar/tests/support.tcl new file mode 100644 index 00000000..9e8af1d3 --- /dev/null +++ b/src/bootsupport/lib/tar/tests/support.tcl @@ -0,0 +1,149 @@ + +proc stream {{size 128000}} { + set chan [tcl::chan::memchan] + set line {} + while 1 { + incr i + set istring $i + set ilen [string length $istring] + if {$line ne {}} { + append line { } + incr size -1 + } + append line $istring + incr size -$ilen + if {$size < 1} { + set line [string range $line 0 end-[expr {abs(1-$size)}]] + puts $chan $line + break + } + + if {$i % 10 == 0} { + puts $chan $line + incr size -1 ;# for the [puts] newline + set line {} + } + } + + seek $chan 0 + return $chan +} + +proc header_posix {tarball} { + dict with tarball {} + tar::formatHeader $path \ + [dict create \ + mode $mode \ + type $type \ + uid $uid \ + gid $gid \ + size $size \ + mtime $mtime] +} + +proc setup1 {} { + variable chan1 + variable res {} + variable tmpdir tartest + + tcltest::makeDirectory $tmpdir + + foreach directory { + one + one/two + one/three + } { + tcltest::makeDirectory $tmpdir/$directory + set chan [open $tmpdir/$directory/a w] + puts $chan hello[incr i] + close $chan + } + set chan1 [stream] +} + +proc large-path {} { + return aaaaa/bbbbaaaaa/bbbbaaaaa/bbbbaaaaa/bbbbaaaaa/bbbbaaaaa/bbbbaaaaa/bbbbaaaaa/bbbbaaaaa/bbbbaaaaa/bbbbtcllib/modules/tar +} + +proc setup2 {} { + variable chan1 + variable res {} + variable tmpdir tartest + variable tmpfile tarX + + tcltest::makeDirectory $tmpdir + tcltest::makeFile {} $tmpfile + + foreach directory [list [large-path]] { + tcltest::makeDirectory $tmpdir/$directory + set chan [open $tmpdir/$directory/a w] + puts $chan hello[incr i] + close $chan + } + set chan1 [open $tmpfile w+] +} + +proc cleanup1 {} { + variable chan1 + close $chan1 + tcltest::removeDirectory tartest + return +} + +proc cleanup2 {} { + variable chan1 + variable tmpdir + variable tmpfile + catch { close $chan1 } + tcltest::removeDirectory $tmpdir + tcltest::removeFile $tmpfile + tcltest::removeFile $tmpfile.err + return +} + +variable filesys { + Dir1 { + File1 { + type 0 + mode 755 + uid 13103 + gid 18103 + size 100 + mtime 5706756101 + } + } + + Dir2 { + File1 { + type 0 + mode 644 + uid 15103 + gid 19103 + size 100 + mtime 5706776103 + } + } +} + +proc setup-tkt-9f4c0e3e95 {} { + variable tmpdir tartest + + tcltest::makeDirectory $tmpdir + tcltest::makeFile {zero-two} $tmpdir/02 + tcltest::makeFile {number two} $tmpdir/2 + + set here [pwd] + cd $tmpdir + tar::create t.tar {2 02} + cd $here + + return $tmpdir/t.tar +} + +proc cleanup-tkt-9f4c0e3e95 {} { + variable tmpdir + tcltest::removeFile $tmpdir/2 + tcltest::removeFile $tmpdir/02 + tcltest::removeDirectory $tmpdir + return +} diff --git a/src/bootsupport/modules/punk/nav/fs-0.1.0.tm b/src/bootsupport/modules/punk/nav/fs-0.1.0.tm index 9c7fd73c..426271a7 100644 --- a/src/bootsupport/modules/punk/nav/fs-0.1.0.tm +++ b/src/bootsupport/modules/punk/nav/fs-0.1.0.tm @@ -378,7 +378,7 @@ tcl::namespace::eval punk::nav::fs { } } } - set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location -with_sizes {f d l} -with_times {f d l}] + set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob -with_sizes {f d l} -with_times {f d l} $location] #puts stderr "=--->$matchinfo" @@ -694,7 +694,7 @@ tcl::namespace::eval punk::nav::fs { } } puts "--> -searchbase:$searchbase searchspec:$searchspec -tailglob:$tailglob location:$location" - set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob -with_times {f d l} $location] + set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob -with_times {f d l} -with_sizes {f d l} $location] return [dirfiles_dict_as_lines -stripbase $opt_stripbase -formatsizes $opt_formatsizes $contents] } @@ -1179,6 +1179,7 @@ tcl::namespace::eval punk::nav::fs { set shortcutinfo [punk::winlnk::file_get_info $fname] set target_type "file" ;#default/fallback if {[dict exists $shortcutinfo link_target]} { + set is_valid_lnk 1 set tgt [dict get $shortcutinfo link_target] if {[file exists $tgt]} { #file type could return 'link' - we will use isfile/isdirectory @@ -1193,21 +1194,47 @@ tcl::namespace::eval punk::nav::fs { #todo - see if punk::winlnk has info about the type at the time of linking #for now - treat as file } + } else { + #no link_target - probably an ordinary file - but there could have been some other error in reading the binary windows lnk format. + set is_valid_lnk 0 } - switch -- $target_type { - file { - set display [dict get $fdict display] - set display "$fshortcut_style$display (shortcut to $tgt)" ;# - dict set fdict display $display - lappend finfo_plus $fdict + if {$is_valid_lnk} { + switch -- $target_type { + file { + set display [dict get $fdict display] + set display "$fshortcut_style$display (shortcut $tgt)" ;# + dict set fdict display $display + lappend finfo_plus $fdict + } + directory { + #target of link is a dir - for display/categorisation purposes we want to see it as a dir + #will be styled later based on membership of dir_shortcuts + lappend dirs $fname + lappend dir_shortcuts $fname + } } - directory { - #target of link is a dir - for display/categorisation purposes we want to see it as a dir - #will be styled later based on membership of dir_shortcuts - lappend dirs $fname - lappend dir_shortcuts $fname + } else { + #we were unable to get link_target - but we still need to check if it failed the header check (then assume not intended to be a windows shell lnk) or for some other reason. + if {[dict exists $shortcutinfo error]} { + if {[dict get $shortcutinfo error] ne "lnk_header_check_failed"} { + #Presumably there is a valid lnk header, but some unexpected error occurred - show it in the display for the file + #still style as a windows shell lnk - as to get here, the header check must have passed. + set display [dict get $fdict display] + set display "$fshortcut_style$display (shortcut error [dict get $shortcutinfo error])" ;# + dict set fdict display $display + lappend finfo_plus $fdict + } else { + #error of lnk_header_check_failed means it probably just isn't a windows shell link. Leave ordinary display for file. + lappend finfo_plus $fdict + } + } else { + #shouldn't ever happen. If no error, then there should have been a link_target + #report and move on + puts stderr "Unexpected error in result of parsing binary format for $fname" + lappend finfo_plus $fdict } } + #assert - we have either appended to finfo_plus (possibly with shortcut info/error if binary header was valid) - or appended to dirs (if it was a valid lnk and target was a dir) } #if we don't have punk::winlnk to read the .lnk - it will get no special highlighting and just appear as an ordinary file even if it points to a dir } else { diff --git a/src/modules/punk/nav/fs-999999.0a1.0.tm b/src/modules/punk/nav/fs-999999.0a1.0.tm index 043181af..fb4fb045 100644 --- a/src/modules/punk/nav/fs-999999.0a1.0.tm +++ b/src/modules/punk/nav/fs-999999.0a1.0.tm @@ -378,7 +378,7 @@ tcl::namespace::eval punk::nav::fs { } } } - set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location -with_sizes {f d l} -with_times {f d l}] + set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob -with_sizes {f d l} -with_times {f d l} $location] #puts stderr "=--->$matchinfo" @@ -694,7 +694,7 @@ tcl::namespace::eval punk::nav::fs { } } puts "--> -searchbase:$searchbase searchspec:$searchspec -tailglob:$tailglob location:$location" - set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob -with_times {f d l} $location] + set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob -with_times {f d l} -with_sizes {f d l} $location] return [dirfiles_dict_as_lines -stripbase $opt_stripbase -formatsizes $opt_formatsizes $contents] } @@ -1179,6 +1179,7 @@ tcl::namespace::eval punk::nav::fs { set shortcutinfo [punk::winlnk::file_get_info $fname] set target_type "file" ;#default/fallback if {[dict exists $shortcutinfo link_target]} { + set is_valid_lnk 1 set tgt [dict get $shortcutinfo link_target] if {[file exists $tgt]} { #file type could return 'link' - we will use isfile/isdirectory @@ -1193,21 +1194,47 @@ tcl::namespace::eval punk::nav::fs { #todo - see if punk::winlnk has info about the type at the time of linking #for now - treat as file } + } else { + #no link_target - probably an ordinary file - but there could have been some other error in reading the binary windows lnk format. + set is_valid_lnk 0 } - switch -- $target_type { - file { - set display [dict get $fdict display] - set display "$fshortcut_style$display (shortcut to $tgt)" ;# - dict set fdict display $display - lappend finfo_plus $fdict + if {$is_valid_lnk} { + switch -- $target_type { + file { + set display [dict get $fdict display] + set display "$fshortcut_style$display (shortcut $tgt)" ;# + dict set fdict display $display + lappend finfo_plus $fdict + } + directory { + #target of link is a dir - for display/categorisation purposes we want to see it as a dir + #will be styled later based on membership of dir_shortcuts + lappend dirs $fname + lappend dir_shortcuts $fname + } } - directory { - #target of link is a dir - for display/categorisation purposes we want to see it as a dir - #will be styled later based on membership of dir_shortcuts - lappend dirs $fname - lappend dir_shortcuts $fname + } else { + #we were unable to get link_target - but we still need to check if it failed the header check (then assume not intended to be a windows shell lnk) or for some other reason. + if {[dict exists $shortcutinfo error]} { + if {[dict get $shortcutinfo error] ne "lnk_header_check_failed"} { + #Presumably there is a valid lnk header, but some unexpected error occurred - show it in the display for the file + #still style as a windows shell lnk - as to get here, the header check must have passed. + set display [dict get $fdict display] + set display "$fshortcut_style$display (shortcut error [dict get $shortcutinfo error])" ;# + dict set fdict display $display + lappend finfo_plus $fdict + } else { + #error of lnk_header_check_failed means it probably just isn't a windows shell link. Leave ordinary display for file. + lappend finfo_plus $fdict + } + } else { + #shouldn't ever happen. If no error, then there should have been a link_target + #report and move on + puts stderr "Unexpected error in result of parsing binary format for $fname" + lappend finfo_plus $fdict } } + #assert - we have either appended to finfo_plus (possibly with shortcut info/error if binary header was valid) - or appended to dirs (if it was a valid lnk and target was a dir) } #if we don't have punk::winlnk to read the .lnk - it will get no special highlighting and just appear as an ordinary file even if it points to a dir } else { diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm index 9c7fd73c..426271a7 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm @@ -378,7 +378,7 @@ tcl::namespace::eval punk::nav::fs { } } } - set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location -with_sizes {f d l} -with_times {f d l}] + set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob -with_sizes {f d l} -with_times {f d l} $location] #puts stderr "=--->$matchinfo" @@ -694,7 +694,7 @@ tcl::namespace::eval punk::nav::fs { } } puts "--> -searchbase:$searchbase searchspec:$searchspec -tailglob:$tailglob location:$location" - set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob -with_times {f d l} $location] + set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob -with_times {f d l} -with_sizes {f d l} $location] return [dirfiles_dict_as_lines -stripbase $opt_stripbase -formatsizes $opt_formatsizes $contents] } @@ -1179,6 +1179,7 @@ tcl::namespace::eval punk::nav::fs { set shortcutinfo [punk::winlnk::file_get_info $fname] set target_type "file" ;#default/fallback if {[dict exists $shortcutinfo link_target]} { + set is_valid_lnk 1 set tgt [dict get $shortcutinfo link_target] if {[file exists $tgt]} { #file type could return 'link' - we will use isfile/isdirectory @@ -1193,21 +1194,47 @@ tcl::namespace::eval punk::nav::fs { #todo - see if punk::winlnk has info about the type at the time of linking #for now - treat as file } + } else { + #no link_target - probably an ordinary file - but there could have been some other error in reading the binary windows lnk format. + set is_valid_lnk 0 } - switch -- $target_type { - file { - set display [dict get $fdict display] - set display "$fshortcut_style$display (shortcut to $tgt)" ;# - dict set fdict display $display - lappend finfo_plus $fdict + if {$is_valid_lnk} { + switch -- $target_type { + file { + set display [dict get $fdict display] + set display "$fshortcut_style$display (shortcut $tgt)" ;# + dict set fdict display $display + lappend finfo_plus $fdict + } + directory { + #target of link is a dir - for display/categorisation purposes we want to see it as a dir + #will be styled later based on membership of dir_shortcuts + lappend dirs $fname + lappend dir_shortcuts $fname + } } - directory { - #target of link is a dir - for display/categorisation purposes we want to see it as a dir - #will be styled later based on membership of dir_shortcuts - lappend dirs $fname - lappend dir_shortcuts $fname + } else { + #we were unable to get link_target - but we still need to check if it failed the header check (then assume not intended to be a windows shell lnk) or for some other reason. + if {[dict exists $shortcutinfo error]} { + if {[dict get $shortcutinfo error] ne "lnk_header_check_failed"} { + #Presumably there is a valid lnk header, but some unexpected error occurred - show it in the display for the file + #still style as a windows shell lnk - as to get here, the header check must have passed. + set display [dict get $fdict display] + set display "$fshortcut_style$display (shortcut error [dict get $shortcutinfo error])" ;# + dict set fdict display $display + lappend finfo_plus $fdict + } else { + #error of lnk_header_check_failed means it probably just isn't a windows shell link. Leave ordinary display for file. + lappend finfo_plus $fdict + } + } else { + #shouldn't ever happen. If no error, then there should have been a link_target + #report and move on + puts stderr "Unexpected error in result of parsing binary format for $fname" + lappend finfo_plus $fdict } } + #assert - we have either appended to finfo_plus (possibly with shortcut info/error if binary header was valid) - or appended to dirs (if it was a valid lnk and target was a dir) } #if we don't have punk::winlnk to read the .lnk - it will get no special highlighting and just appear as an ordinary file even if it points to a dir } else { diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm index 9c7fd73c..426271a7 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm @@ -378,7 +378,7 @@ tcl::namespace::eval punk::nav::fs { } } } - set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location -with_sizes {f d l} -with_times {f d l}] + set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob -with_sizes {f d l} -with_times {f d l} $location] #puts stderr "=--->$matchinfo" @@ -694,7 +694,7 @@ tcl::namespace::eval punk::nav::fs { } } puts "--> -searchbase:$searchbase searchspec:$searchspec -tailglob:$tailglob location:$location" - set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob -with_times {f d l} $location] + set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob -with_times {f d l} -with_sizes {f d l} $location] return [dirfiles_dict_as_lines -stripbase $opt_stripbase -formatsizes $opt_formatsizes $contents] } @@ -1179,6 +1179,7 @@ tcl::namespace::eval punk::nav::fs { set shortcutinfo [punk::winlnk::file_get_info $fname] set target_type "file" ;#default/fallback if {[dict exists $shortcutinfo link_target]} { + set is_valid_lnk 1 set tgt [dict get $shortcutinfo link_target] if {[file exists $tgt]} { #file type could return 'link' - we will use isfile/isdirectory @@ -1193,21 +1194,47 @@ tcl::namespace::eval punk::nav::fs { #todo - see if punk::winlnk has info about the type at the time of linking #for now - treat as file } + } else { + #no link_target - probably an ordinary file - but there could have been some other error in reading the binary windows lnk format. + set is_valid_lnk 0 } - switch -- $target_type { - file { - set display [dict get $fdict display] - set display "$fshortcut_style$display (shortcut to $tgt)" ;# - dict set fdict display $display - lappend finfo_plus $fdict + if {$is_valid_lnk} { + switch -- $target_type { + file { + set display [dict get $fdict display] + set display "$fshortcut_style$display (shortcut $tgt)" ;# + dict set fdict display $display + lappend finfo_plus $fdict + } + directory { + #target of link is a dir - for display/categorisation purposes we want to see it as a dir + #will be styled later based on membership of dir_shortcuts + lappend dirs $fname + lappend dir_shortcuts $fname + } } - directory { - #target of link is a dir - for display/categorisation purposes we want to see it as a dir - #will be styled later based on membership of dir_shortcuts - lappend dirs $fname - lappend dir_shortcuts $fname + } else { + #we were unable to get link_target - but we still need to check if it failed the header check (then assume not intended to be a windows shell lnk) or for some other reason. + if {[dict exists $shortcutinfo error]} { + if {[dict get $shortcutinfo error] ne "lnk_header_check_failed"} { + #Presumably there is a valid lnk header, but some unexpected error occurred - show it in the display for the file + #still style as a windows shell lnk - as to get here, the header check must have passed. + set display [dict get $fdict display] + set display "$fshortcut_style$display (shortcut error [dict get $shortcutinfo error])" ;# + dict set fdict display $display + lappend finfo_plus $fdict + } else { + #error of lnk_header_check_failed means it probably just isn't a windows shell link. Leave ordinary display for file. + lappend finfo_plus $fdict + } + } else { + #shouldn't ever happen. If no error, then there should have been a link_target + #report and move on + puts stderr "Unexpected error in result of parsing binary format for $fname" + lappend finfo_plus $fdict } } + #assert - we have either appended to finfo_plus (possibly with shortcut info/error if binary header was valid) - or appended to dirs (if it was a valid lnk and target was a dir) } #if we don't have punk::winlnk to read the .lnk - it will get no special highlighting and just appear as an ordinary file even if it points to a dir } else { diff --git a/src/runtime/mapvfs.config b/src/runtime/mapvfs.config index 74876865..012ad75f 100644 --- a/src/runtime/mapvfs.config +++ b/src/runtime/mapvfs.config @@ -33,7 +33,7 @@ tclkit87a5.exe {punk8win.vfs punk87} ################################## #TCL9 tclsh90b2 {punk9win.vfs punk90b2 zip} -tclsh90b4_piperepl.exe {punk9win.vfs punk90b4 zip} {critcl.vfs critcl9 zip} +#tclsh90b4_piperepl.exe {punk9win.vfs punk90b4 zip} {critcl.vfs critcl9 zip} ################################## diff --git a/src/vfs/_vfscommon/modules/punk/du-0.1.0.tm b/src/vfs/_vfscommon/modules/punk/du-0.1.0.tm index f2ee38b5..1e1986e6 100644 --- a/src/vfs/_vfscommon/modules/punk/du-0.1.0.tm +++ b/src/vfs/_vfscommon/modules/punk/du-0.1.0.tm @@ -19,6 +19,7 @@ ##e.g package require frobz package require punk::mix::base package require struct::set +package require punk::args namespace eval punk::du { @@ -486,29 +487,156 @@ namespace eval punk::du { return [lindex [lappend winfile_attributes $bitmask [twapi::decode_file_attributes $bitmask]] end] } } - proc attributes_twapi {path {detail basic}} { + variable win_reparse_tags + #implied prefix for all names IO_REPARSE_TAG_ + #list of reparse tags: https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/c8e77b37-3909-4fe6-a4ea-2b9d423b1ee4 + set win_reparse_tags [dict create\ + RESERVED_ZERO [list hex 0x00000000 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\ + RESERVED_ONE [list hex 0x00000001 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\ + RESERVED_TWO [list hex 0x00000002 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\ + MOUNT_POINT [list hex 0xA0000003 obsolete 0 serverside 0 meaning "Used for mount point support"]\ + HSM [list hex 0xC0000004 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\ + DRIVE_EXTENDER [list hex 0x80000005 obsolete 0 serverside 0 meaning "Home server drive extender"]\ + HSM2 [list hex 0xC0000006 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\ + SIS [list hex 0x80000007 obsolete 0 serverside 1 meaning "Used by single-instance storage (SIS) filter driver."]\ + WIM [list hex 0x80000008 obsolete 0 serverside 1 meaning "Used by the WIM Mount filter."]\ + CSV [list hex 0x80000008 obsolete 1 serverside 1 meaning "Obsolete. Used by Clustered Shared Volumes (CSV) version 1 in Windows Server 2008 R2 operating system. "]\ + DFS [list hex 0x8000000A obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in the Distributed File System (DFS): Referral Protocol Specification \[MS-DFSC\]."]\ + FILTER_MANAGER [list hex 0x8000000B obsolete 0 serverside 0 meaning "Used by filter manager test harness"]\ + SYMLINK [list hex 0xA000000C obsolete 0 serverside 0 meaning "Used for symbolic link support."]\ + IIS_CACHE [list hex 0xA0000010 obsolete 0 serverside 1 meaning "Used by Microsoft Internet Information Services (IIS) caching. "]\ + DFSR [list hex 0x80000012 obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in \[MS-DFSC\]. "]\ + DEDUP [list hex 0x80000013 obsolete 0 serverside 1 meaning "Used by the Data Deduplication (Dedup) filter. "]\ + APPXSTRM [list hex 0xC0000014 obsolete 0 serverside 0 meaning "Not used."]\ + NFS [list hex 0x80000014 obsolete 0 serverside 1 meaning "Used by the Network File System (NFS) component. "]\ + FILE_PLACEHOLDER [list hex 0x80000015 obsolete 1 serverside 1 meaning "Obsolete. Used by Windows Shell for legacy placeholder files in Windows 8.1. "]\ + DFM [list hex 0x80000016 obsolete 0 serverside 1 meaning "Used by the Dynamic File filter. "]\ + WOF [list hex 0x80000017 obsolete 0 serverside 1 meaning "Used by the Windows Overlay filter, for either WIMBoot or single-file compression."]\ + WCI [list hex 0x80000018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\ + WCI_2 [list hex 0x90001018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\ + GLOBAL_REPARSE [list hex 0xA0000019 obsolete 0 serverside 1 meaning "Used by NPFS to indicate a named pipe symbolic link from a server silo into the host silo."]\ + CLOUD [list hex 0x9000001A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_1 [list hex 0x9000101A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_2 [list hex 0x9000201A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_3 [list hex 0x9000301A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_4 [list hex 0x9000401A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_5 [list hex 0x9000501A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_6 [list hex 0x9000601A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_7 [list hex 0x9000701A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_8 [list hex 0x9000801A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_9 [list hex 0x9000901A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_A [list hex 0x9000A01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_B [list hex 0x9000B01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_C [list hex 0x9000C01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_D [list hex 0x9000D01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_E [list hex 0x9000E01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_F [list hex 0x9000F01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + APPEXECLINK [list hex 0x8000001B obsolete 0 serverside 1 meaning "Used by Universal Windows Platform (UWP) packages to encode information that allows the application to be launched by CreateProcess."]\ + PROJFS [list hex 0x9000001C obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\ + LX_SYMLINK [list hex 0xA000001D obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX symbolic link."]\ + STORAGE_SYNC [list hex 0x8000001E obsolete 0 serverside 1 meaning "Used by the Azure File Sync (AFS) filter."]\ + WCI_TOMBSTONE [list hex 0xA000001F obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + UNHANDLED [list hex 0x80000020 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + ONEDRIVE [list hex 0x80000021 obsolete 0 serverside 0 meaning "Not used"]\ + PROJFS_TOMBSTONE [list hex 0xA0000022 obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\ + AF_UNIX [list hex 0x80000023 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX domain socket."]\ + LX_FIFO [list hex 0x80000024 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX FIFO (named pipe)."]\ + LX_CHR [list hex 0x80000025 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX character special file."]\ + LX_BLK [list hex 0x80000026 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX block special file."]\ + WCI_LINK [list hex 0xA0000027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + WCI_LINK_1 [list hex 0xA0001027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + ] + variable win_reparse_tags_by_int + dict for {k v} $win_reparse_tags { + set intkey [expr {[dict get $v hex]}] + set info [dict merge [dict create tag $k] $v] ;#put tag at front + dict set win_reparse_tags_by_int $intkey $info + } + + #https://stackoverflow.com/questions/46383428/get-the-immediate-target-path-from-symlink-reparse-point + #need to call twapi::create_file with FILE_FLAG_OPEN_REPARSE_POINT 0x00200000 + #then twapi::device_ioctl (win32 DeviceIoControl) + #then parse buffer somehow (binary scan..) + #https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/b41f1cbf-10df-4a47-98d4-1c52a833d913 + + proc Get_attributes_from_iteminfo {args} { + variable win_reparse_tags_by_int + + set argd [punk::args::get_dict { + -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" + -debugchannel -default stderr -help "channel to write debug output, or none to append to output" + *values -min 1 -max 1 + iteminfo -help "iteminfo dict as set by 'twapi::find_file_next iteminfo'" + } $args] + set opts [dict get $argd opts] + set iteminfo [dict get $argd values iteminfo] + set opt_debug [dict get $opts -debug] + set opt_debugchannel [dict get $opts -debugchannel] + #-longname is placeholder - caller needs to set + set result [dict create -archive 0 -hidden 0 -longname [dict get $iteminfo name] -readonly 0 -shortname {} -system 0] + if {$opt_debug} { + set dbg "iteminfo returned by find_file_open\n" + append dbg [pdict -channel none iteminfo] + if {$opt_debugchannel eq "none"} { + dict set result -debug $dbg + } else { + puts -nonewline $opt_debugchannel $dbg + } + + } + + set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] + if {"hidden" in $attrinfo} { + dict set result -hidden 1 + } + if {"system" in $attrinfo} { + dict set result -system 1 + } + if {"readonly" in $attrinfo} { + dict set result -readonly 1 + } + dict set result -shortname [dict get $iteminfo altname] + dict set result -fileattributes $attrinfo + if {"reparse_point" in $attrinfo} { + #the twapi API splits this 32bit value for us + set low_word [dict get $iteminfo reserve0] + set high_word [dict get $iteminfo reserve1] + # 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 + # 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 + #+-+-+-+-+-----------------------+-------------------------------+ + #|M|R|N|R| Reserved bits | Reparse tag value | + #+-+-+-+-+-----------------------+-------------------------------+ + #todo - is_microsoft from first bit of high_word + set low_int [expr {$low_word}] ;#review - int vs string rep for dict key lookup? does it matter? + if {[dict exists $win_reparse_tags_by_int $low_int]} { + dict set result -reparseinfo [dict get $win_reparse_tags_by_int $low_int] + } else { + dict set result -reparseinfo [dict create tag "" hex 0x[format %X $low_int] meaning "unknown reparse tag int:$low_int"] + } + } + dict set result -raw $iteminfo + return $result + } + + + proc attributes_twapi {args} { + set argd [punk::args::get_dict { + -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" + -debugchannel -default stderr -help "channel to write debug output, or none to append to output" + -detail -default basic -choices {basic full} -help "full returns also the altname/shortname field" + *values -min 1 -max 1 + path -help "path to file or folder for which to retrieve attributes" + } $args] + set opts [dict get $argd opts] + set path [dict get $argd values path] + set opt_detail [dict get $opts -detail] + set opt_debug [dict get $opts -debug] + set opt_debugchannel [dict get $opts -debugchannel] + try { - set iterator [twapi::find_file_open $path -detail $detail] ;# -detail full only adds data to the altname field + set iterator [twapi::find_file_open $path -detail $opt_detail] ;# -detail full only adds data to the altname field if {[twapi::find_file_next $iterator iteminfo]} { - set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] - set result [dict create -archive 0 -hidden 0 -longname $path -readonly 0 -shortname {} -system 0] - if {"hidden" in $attrinfo} { - dict set result -hidden 1 - } - if {"system" in $attrinfo} { - dict set result -system 1 - } - if {"readonly" in $attrinfo} { - dict set result -readonly 1 - } - dict set result -shortname [dict get $iteminfo altname] - dict set result -rawflags $attrinfo - set extras [list] - #foreach prop {ctime atime mtime size} { - # lappend extras $prop [dict get $iteminfo $prop] - #} - #dict set result -extras $extras - dict set result -raw $iteminfo + set result [Get_attributes_from_iteminfo -debug $opt_debug -debugchannel $opt_debugchannel $iteminfo] return $result } else { error "could not read attributes for $path" @@ -519,13 +647,14 @@ namespace eval punk::du { } #todo - review 'errors' key. We have errors relating to containing folder and args vs per child-item errors - additional key needed? - namespace export du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided + namespace export attributes_twapi du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided du_dirlisting_tclvfs # get listing without using unix-tools (may not be installed on the windows system) # this dirlisting is customised for du - so only retrieves dirs,files,filesizes (minimum work needed to perform du function) # This also preserves path rep for elements in the dirs/folders keys etc - which can make a big difference in performance proc du_dirlisting_twapi {folderpath args} { set defaults [dict create\ -glob *\ + -filedebug 0\ -with_sizes 1\ -with_times 1\ ] @@ -534,6 +663,9 @@ namespace eval punk::du { set opt_glob [dict get $opts -glob] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_with_sizes [dict get $opts -with_sizes] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- + set opt_filedebug [dict get $opts -filedebug] ;#per file + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- set ftypes [list f d l] if {"$opt_with_sizes" in {0 1}} { #don't use string is boolean - (f false vs f file!) @@ -705,6 +837,8 @@ namespace eval punk::du { set alltimes [dict create] set links [list] + set linkinfo [dict create] + set debuginfo [dict create] set flaggedhidden [list] set flaggedsystem [list] set flaggedreadonly [list] @@ -717,25 +851,18 @@ namespace eval punk::du { continue } set tail_altname [dict get $iteminfo altname] ;#altname of tail - not whole path - set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] - #puts stderr "$iteminfo" - #puts stderr "$nm -> [dict get $iteminfo attrs] -> $attrinfo" + #set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] set ftype "" #attributes applicable to any classification set fullname [file_join_one $folderpath $nm] - if {"hidden" in $attrinfo} { - lappend flaggedhidden $fullname - } - if {"system" in $attrinfo} { - lappend flaggedsystem $fullname - } - if {"readonly" in $attrinfo} { - lappend flaggedreadonly $fullname - } + set attrdict [Get_attributes_from_iteminfo -debug $opt_filedebug -debugchannel none $iteminfo] ;#-debugchannel none puts -debug key in the resulting dict + set file_attributes [dict get $attrdict -fileattributes] + set linkdata [dict create] + # ----------------------------------------------------------- #main classification - if {"reparse_point" in $attrinfo} { + if {"reparse_point" in $file_attributes} { #this concept doesn't correspond 1-to-1 with unix links #https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points #review - and see which if any actually belong in the links key of our return @@ -758,17 +885,27 @@ namespace eval punk::du { #Note also - a shortcut created in explorer with drag and drop to an existant folder is a different animal to a symlink (file with .lnk extension) even though it looks the same in explorer window. # #links are techically files too, whether they point to a file/dir or nothing. - lappend links $fullname set ftype "l" - } elseif {"directory" in $attrinfo} { + dict set linkdata linktype reparse_point + dict set linkdata reparseinfo [dict get $attrdict -reparseinfo] + if {"directory" ni $file_attributes} { + dict set linkdata target_type file + } + } + if {"directory" in $file_attributes} { if {$nm in {. ..}} { continue } - lappend dirs $fullname - set ftype "d" - } else { - + if {"reparse_point" ni $file_attributes} { + lappend dirs $fullname + set ftype "d" + } else { + #other mechanisms can't immediately classify a link as file vs directory - so we don't return this info in the main dirs/files collections + dict set linkdata target_type directory + } + } + if {"reparse_point" ni $file_attributes && "directory" ni $file_attributes} { #review - is anything that isn't a reparse_point or a directory, some sort of 'file' in this context? What about the 'device' attribute? Can that occur in a directory listing of some sort? lappend files $fullname if {"f" in $sized_types} { @@ -776,6 +913,17 @@ namespace eval punk::du { } set ftype "f" } + # ----------------------------------------------------------- + + if {[dict get $attrdict -hidden]} { + lappend flaggedhidden $fullname + } + if {[dict get $attrdict -system]} { + lappend flaggedsystem $fullname + } + if {[dict get $attrdict -readonly]} { + lappend flaggedreadonly $fullname + } if {$ftype in $sized_types} { dict set allsizes $fullname [dict create bytes [dict get $iteminfo size]] } @@ -789,6 +937,12 @@ namespace eval punk::du { m [twapi::large_system_time_to_secs_since_1970 [dict get $iteminfo mtime]]\ ] } + if {[dict size $linkdata]} { + dict set linkinfo $fullname $linkdata + } + if {[dict exists $attrdict -debug]} { + dict set debuginfo $fullname [dict get $attrdict -debug] + } } twapi::find_file_close $iterator set vfsmounts [get_vfsmounts_in_folder $folderpath] @@ -799,7 +953,7 @@ namespace eval punk::du { #also determine whether vfs. file system x is *much* faster than file attributes #whether or not there is a corresponding file/dir add any applicable mountpoints for the containing folder - return [list dirs $dirs vfsmounts $vfsmounts links $links files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts errors $errors] + return [list dirs $dirs vfsmounts $vfsmounts links $links linkinfo $linkinfo files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts debuginfo $debuginfo errors $errors] } proc get_vfsmounts_in_folder {folderpath} { set vfsmounts [list] diff --git a/src/vfs/_vfscommon/modules/punk/nav/fs-0.1.0.tm b/src/vfs/_vfscommon/modules/punk/nav/fs-0.1.0.tm index fdffa091..426271a7 100644 --- a/src/vfs/_vfscommon/modules/punk/nav/fs-0.1.0.tm +++ b/src/vfs/_vfscommon/modules/punk/nav/fs-0.1.0.tm @@ -196,12 +196,12 @@ tcl::namespace::eval punk::nav::fs { commandstack::basecall cd $VIRTUAL_CWD } } - set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD] + set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD -with_times {f d l} -with_sizes {f d l}] } else { if {[pwd] ne $VIRTUAL_CWD} { commandstack::basecall cd $VIRTUAL_CWD } - set matchinfo [dirfiles_dict -searchbase [pwd]] + set matchinfo [dirfiles_dict -searchbase [pwd] -with_times {f d l} -with_sizes {f d l}] } set dircount [llength [dict get $matchinfo dirs]] set filecount [llength [dict get $matchinfo files]] @@ -378,7 +378,7 @@ tcl::namespace::eval punk::nav::fs { } } } - set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location] + set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob -with_sizes {f d l} -with_times {f d l} $location] #puts stderr "=--->$matchinfo" @@ -467,7 +467,7 @@ tcl::namespace::eval punk::nav::fs { } set normpath [file normalize $path] cd $normpath - set matchinfo [dirfiles_dict -searchbase $normpath $normpath] + set matchinfo [dirfiles_dict -searchbase $normpath -with_sizes {f d l} -with_times {f d l} $normpath] set dircount [llength [dict get $matchinfo dirs]] set filecount [llength [dict get $matchinfo files]] set location [file normalize [dict get $matchinfo location]] @@ -626,7 +626,7 @@ tcl::namespace::eval punk::nav::fs { proc dirlist {{location ""}} { - set contents [dirfiles_dict $location] + set contents [dirfiles_dict -with_times {f d l} -with_sizes {f d l} $location] return [dirfiles_dict_as_lines -stripbase 1 $contents] } @@ -694,7 +694,7 @@ tcl::namespace::eval punk::nav::fs { } } puts "--> -searchbase:$searchbase searchspec:$searchspec -tailglob:$tailglob location:$location" - set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob $location] + set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob -with_times {f d l} -with_sizes {f d l} $location] return [dirfiles_dict_as_lines -stripbase $opt_stripbase -formatsizes $opt_formatsizes $contents] } @@ -1038,17 +1038,20 @@ tcl::namespace::eval punk::nav::fs { lappend vfsmounts {*}[dict get $contents vfsmounts] } + set fkeys [dict create] ;#avoid some file normalize calls.. if {$opt_stripbase && $common_base ne ""} { set filetails [list] set dirtails [list] foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] { set stripped [list] - foreach f [set $fileset] { - lappend stripped [strip_prefix_depth $f $common_base] + foreach fullname [set $fileset] { + set shortname [strip_prefix_depth $fullname $common_base] + dict set fkeys $shortname $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem + lappend stripped $shortname } set $fileset $stripped } - #Note: we need to remember to use common_base to rebuild the key when we need to query the dict-based elements: sizes & times - because we didn't strip those keys. + #Note: without fkeys we would need to remember to use common_base to rebuild (and file normalize!) the key when we need to query the dict-based elements: sizes & times - because we didn't strip those keys. } # -- --- --- --- --- --- --- --- --- --- --- @@ -1060,15 +1063,33 @@ tcl::namespace::eval punk::nav::fs { set dir_symlinks [list] set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory foreach s $links { - if {[file isfile $s]} { - lappend file_symlinks $s - #will be appended in finfo_plus later - } elseif {[file isdirectory $s]} { - lappend dir_symlinks $s - lappend dirs $s + if {[dict exists $contents linkinfo $s target_type]} { + #some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem. + set target_type [dict get $contents linkinfo $s target_type] + switch -- $target_type { + file { + lappend file_symlinks $s + } + directory { + lappend dir_symlinks $s + lappend dirs $s + } + default { + puts stderr "Warning - cannot determine link type for link $s (target_type value is:$target_type)" + } + } } else { - #dunno - warn for now - puts stderr "Warning - cannot determine link type for link $s" + #fallback if no target_type + if {[file isfile $s]} { + lappend file_symlinks $s + #will be appended in finfo_plus later + } elseif {[file isdirectory $s]} { + lappend dir_symlinks $s + lappend dirs $s + } else { + #dunno - warn for now + puts stderr "Warning - cannot determine link type for link $s" + } } } #we now have the issue that our symlinks aren't sorted within the dir/file categorisation - they currently will have to appear at beginning or end - TODO @@ -1083,28 +1104,66 @@ tcl::namespace::eval punk::nav::fs { if {$opt_formatsizes} { set filesizes [punk::lib::format_number $filesizes] ;#accepts a list and will process each } - #col2 with subcolumns + + #col2 (file info) with subcolumns - #remove punk::pipedata dependency - allow use of punk::nav::fs without punk package - #set widest2a [punk::pipedata [list {*}$files ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}] - #widest2a.= concat $files [list ""] |> .=>2 lmap v {string length $v} |> .=>* tcl::mathfunc::max set widest2a [tcl::mathfunc::max {*}[lmap v [list {*}$files {*}$file_symlinks ""] {string length $v}]] set c2a [string repeat " " [expr {$widest2a + 1}]] #set widest2b [punk::pipedata [list {*}$filesizes ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}] set widest2b [tcl::mathfunc::max {*}[lmap v [list {*}$filesizes ""] {string length $v}]] set c2b [string repeat " " [expr {$widest2b + 1}]] + + #c2c timestamp and short note - fixed width 19 for ts + + filetype note e.g "symlink" "shortcut" "binary" ?? combinations? allow 2 words 10 each for 21 + 1 for luck + # total 42 + set c2c [string repeat " " 42] set finfo [list] foreach f $files s $filesizes { + if {[dict size $fkeys]} { + set key [dict get $fkeys $f] + } else { + #not stripped - they should match + set key $f + } #note - the display entry isn't necessarily a valid tcl list e.g filename with unbalanced curly braces #hence we need to keep the filename as well, properly protected as a list element - lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s]"] + if {[dict exists $contents times $key m]} { + set mtime [dict get $contents times $key m] + set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"] + } else { + #set ts [string repeat { } 19] + set ts "$key vs [dict keys [dict get $contents times]]" + } + set note "" + lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"] } set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline set dlink_style [punk::ansi::a+ undercurly underline undt-green] #We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden foreach flink $file_symlinks { - lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0]"] + if {[dict size $fkeys]} { + set key [dict get $fkeys $flink] + } else { + set key $flink + } + if {[dict exists $contents times $key m]} { + set mtime [dict get $contents times $key m] + set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"] + } else { + set ts "[string repeat { } 19]" + } + set note "link" ;#default only + if {[dict exists $contents linkinfo $key linktype]} { + if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} { + set note "reparse_point" + if {[dict exists $contents linkinfo $key reparseinfo tag]} { + append note " " [dict get $contents linkinfo $key reparseinfo tag] + } + } else { + append note "$key vs [dict keys [dict get $contents linkinfo]]" + } + } + lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"] } set fshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink] @@ -1120,9 +1179,10 @@ tcl::namespace::eval punk::nav::fs { set shortcutinfo [punk::winlnk::file_get_info $fname] set target_type "file" ;#default/fallback if {[dict exists $shortcutinfo link_target]} { + set is_valid_lnk 1 set tgt [dict get $shortcutinfo link_target] if {[file exists $tgt]} { - #file type could return 'link' - we will use ifile/isdirectory + #file type could return 'link' - we will use isfile/isdirectory if {[file isfile $tgt]} { set target_type file } elseif {[file isdirectory $tgt]} { @@ -1134,21 +1194,47 @@ tcl::namespace::eval punk::nav::fs { #todo - see if punk::winlnk has info about the type at the time of linking #for now - treat as file } + } else { + #no link_target - probably an ordinary file - but there could have been some other error in reading the binary windows lnk format. + set is_valid_lnk 0 } - switch -- $target_type { - file { - set display [dict get $fdict display] - set display $fshortcut_style$display ;# - dict set fdict display $display - lappend finfo_plus $fdict + if {$is_valid_lnk} { + switch -- $target_type { + file { + set display [dict get $fdict display] + set display "$fshortcut_style$display (shortcut $tgt)" ;# + dict set fdict display $display + lappend finfo_plus $fdict + } + directory { + #target of link is a dir - for display/categorisation purposes we want to see it as a dir + #will be styled later based on membership of dir_shortcuts + lappend dirs $fname + lappend dir_shortcuts $fname + } } - directory { - #target of link is a dir - for display/categorisation purposes we want to see it as a dir - #will be styled later based on membership of dir_shortcuts - lappend dirs $fname - lappend dir_shortcuts $fname + } else { + #we were unable to get link_target - but we still need to check if it failed the header check (then assume not intended to be a windows shell lnk) or for some other reason. + if {[dict exists $shortcutinfo error]} { + if {[dict get $shortcutinfo error] ne "lnk_header_check_failed"} { + #Presumably there is a valid lnk header, but some unexpected error occurred - show it in the display for the file + #still style as a windows shell lnk - as to get here, the header check must have passed. + set display [dict get $fdict display] + set display "$fshortcut_style$display (shortcut error [dict get $shortcutinfo error])" ;# + dict set fdict display $display + lappend finfo_plus $fdict + } else { + #error of lnk_header_check_failed means it probably just isn't a windows shell link. Leave ordinary display for file. + lappend finfo_plus $fdict + } + } else { + #shouldn't ever happen. If no error, then there should have been a link_target + #report and move on + puts stderr "Unexpected error in result of parsing binary format for $fname" + lappend finfo_plus $fdict } } + #assert - we have either appended to finfo_plus (possibly with shortcut info/error if binary header was valid) - or appended to dirs (if it was a valid lnk and target was a dir) } #if we don't have punk::winlnk to read the .lnk - it will get no special highlighting and just appear as an ordinary file even if it points to a dir } else { diff --git a/src/vfs/_vfscommon/modules/punk/winlnk-0.1.0.tm b/src/vfs/_vfscommon/modules/punk/winlnk-0.1.0.tm index 6a5d4a6d..83684385 100644 --- a/src/vfs/_vfscommon/modules/punk/winlnk-0.1.0.tm +++ b/src/vfs/_vfscommon/modules/punk/winlnk-0.1.0.tm @@ -252,7 +252,7 @@ tcl::namespace::eval punk::winlnk { - #https://github.com/libyal/liblnk/blob/main/documentation/Windows%20Shortcut%20File%20(LNK)%20format.asciidoc + #offset 24 4 bytes #File attribute flags diff --git a/src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/autoscroll/autoscroll.tcl b/src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/autoscroll/autoscroll.tcl new file mode 100644 index 00000000..52211f27 --- /dev/null +++ b/src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/autoscroll/autoscroll.tcl @@ -0,0 +1,238 @@ +# autoscroll.tcl -- +# +# Package to create scroll bars that automatically appear when +# a window is too small to display its content. +# +# Copyright (c) 2003 Kevin B Kenny +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: autoscroll.tcl,v 1.8 2005/06/01 02:37:51 andreas_kupries Exp $ + +package require Tk +package provide autoscroll 1.1 + +namespace eval ::autoscroll { + namespace export autoscroll unautoscroll + bind Autoscroll [namespace code [list destroyed %W]] + bind Autoscroll [namespace code [list map %W]] +} + + #---------------------------------------------------------------------- + # + # ::autoscroll::autoscroll -- + # + # Create a scroll bar that disappears when it is not needed, and + # reappears when it is. + # + # Parameters: + # w -- Path name of the scroll bar, which should already exist + # + # Results: + # None. + # + # Side effects: + # The widget command is renamed, so that the 'set' command can + # be intercepted and determine whether the widget should appear. + # In addition, the 'Autoscroll' bind tag is added to the widget, + # so that the event can be intercepted. + # + #---------------------------------------------------------------------- + +proc ::autoscroll::autoscroll { w } { + if { [info commands ::autoscroll::renamed$w] != "" } { return $w } + rename $w ::autoscroll::renamed$w + interp alias {} ::$w {} ::autoscroll::widgetCommand $w + bindtags $w [linsert [bindtags $w] 1 Autoscroll] + eval [list ::$w set] [renamed$w get] + return $w +} + + #---------------------------------------------------------------------- + # + # ::autoscroll::unautoscroll -- + # + # Return a scrollbar to its normal static behavior by removing + # it from the control of this package. + # + # Parameters: + # w -- Path name of the scroll bar, which must have previously + # had ::autoscroll::autoscroll called on it. + # + # Results: + # None. + # + # Side effects: + # The widget command is renamed to its original name. The widget + # is mapped if it was not currently displayed. The widgets + # bindtags are returned to their original state. Internal memory + # is cleaned up. + # + #---------------------------------------------------------------------- + +proc ::autoscroll::unautoscroll { w } { + if { [info commands ::autoscroll::renamed$w] != "" } { + variable grid + rename ::$w {} + rename ::autoscroll::renamed$w ::$w + if { [set i [lsearch -exact [bindtags $w] Autoscroll]] > -1 } { + bindtags $w [lreplace [bindtags $w] $i $i] + } + if { [info exists grid($w)] } { + eval [join $grid($w) \;] + unset grid($w) + } + } +} + + #---------------------------------------------------------------------- + # + # ::autoscroll::widgetCommand -- + # + # Widget command on an 'autoscroll' scrollbar + # + # Parameters: + # w -- Path name of the scroll bar + # command -- Widget command being executed + # args -- Arguments to the commane + # + # Results: + # Returns whatever the widget command returns + # + # Side effects: + # Has whatever side effects the widget command has. In + # addition, the 'set' widget command is handled specially, + # by gridding/packing the scroll bar according to whether + # it is required. + # + #------------------------------------------------------------ + +proc ::autoscroll::widgetCommand { w command args } { + variable grid + if { $command == "set" } { + foreach { min max } $args {} + if { $min <= 0 && $max >= 1 } { + switch -exact -- [winfo manager $w] { + grid { + lappend grid($w) "[list grid $w] [grid info $w]" + grid forget $w + } + pack { + foreach x [pack slaves [winfo parent $w]] { + lappend grid($w) "[list pack $x] [pack info $x]" + } + pack forget $w + } + } + } elseif { [info exists grid($w)] } { + eval [join $grid($w) \;] + unset grid($w) + } + } + return [eval [list renamed$w $command] $args] +} + + + #---------------------------------------------------------------------- + # + # ::autoscroll::destroyed -- + # + # Callback executed when an automatic scroll bar is destroyed. + # + # Parameters: + # w -- Path name of the scroll bar + # + # Results: + # None. + # + # Side effects: + # Cleans up internal memory. + # + #---------------------------------------------------------------------- + +proc ::autoscroll::destroyed { w } { + variable grid + catch { unset grid($w) } + rename ::$w {} +} + + + #---------------------------------------------------------------------- + # + # ::autoscroll::map -- + # + # Callback executed when an automatic scroll bar is mapped. + # + # Parameters: + # w -- Path name of the scroll bar. + # + # Results: + # None. + # + # Side effects: + # Geometry of the scroll bar's top-level window is constrained. + # + # This procedure keeps the top-level window associated with an + # automatic scroll bar from being resized automatically after the + # scroll bar is mapped. This effect avoids a potential endless loop + # in the case where the resize of the top-level window resizes the + # widget being scrolled, causing the scroll bar no longer to be needed. + # + #---------------------------------------------------------------------- + +proc ::autoscroll::map { w } { + wm geometry [winfo toplevel $w] [wm geometry [winfo toplevel $w]] +} + + #---------------------------------------------------------------------- + # + # ::autoscroll::wrap -- + # + # Arrange for all new scrollbars to be automatically autoscrolled + # + # Parameters: + # None. + # + # Results: + # None. + # + # Side effects: + # ::scrollbar is overloaded to automatically autoscroll any new + # scrollbars. + # + #---------------------------------------------------------------------- + +proc ::autoscroll::wrap {} { + if {[info commands ::autoscroll::_scrollbar] != ""} {return} + rename ::scrollbar ::autoscroll::_scrollbar + proc ::scrollbar {w args} { + eval ::autoscroll::_scrollbar [list $w] $args + ::autoscroll::autoscroll $w + return $w + } +} + + #---------------------------------------------------------------------- + # + # ::autoscroll::unwrap -- + # + # Turns off automatic autoscrolling of new scrollbars. Does not + # effect existing scrollbars. + # + # Parameters: + # None. + # + # Results: + # None. + # + # Side effects: + # ::scrollbar is returned to its original state + # + #---------------------------------------------------------------------- + +proc ::autoscroll::unwrap {} { + if {[info commands ::autoscroll::_scrollbar] == ""} {return} + rename ::scrollbar {} + rename ::autoscroll::_scrollbar ::scrollbar +} diff --git a/src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/autoscroll/pkgIndex.tcl b/src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/autoscroll/pkgIndex.tcl new file mode 100644 index 00000000..061c8799 --- /dev/null +++ b/src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/autoscroll/pkgIndex.tcl @@ -0,0 +1,13 @@ +# Tcl package index file, version 1.1 +# This file is generated by the "pkg_mkIndex" command +# and sourced either when an application starts up or +# by a "package unknown" script. It invokes the +# "package ifneeded" command to set up package-related +# information so that packages will be loaded automatically +# in response to "package require" commands. When this +# script is sourced, the variable $dir must contain the +# full path name of this file's directory. + +if { ![package vsatisfies [package provide Tcl] 8.2] } { return } +package ifneeded autoscroll 1.1 [list source [file join $dir autoscroll.tcl]] + diff --git a/src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/canvas_drag.tcl b/src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/canvas_drag.tcl new file mode 100644 index 00000000..3e9e0ec7 --- /dev/null +++ b/src/vfs/punk8win.vfs/lib_tcl8/tklib0.8/canvas/canvas_drag.tcl @@ -0,0 +1,278 @@ +## -*- tcl -*- +# ### ### ### ######### ######### ######### + +# Canvas Behavior Module. Dragging items and groups of items. + +# ### ### ### ######### ######### ######### +## Requisites + +package require Tcl 8.5- +package require Tk + +# ### ### ### ######### ######### ######### +## API + +namespace eval ::canvas::drag { + namespace export \ + item group on off + namespace ensemble create +} + +proc ::canvas::drag::item {c tag args} { + # Set up dragging of single items identified by the + on $c $tag [namespace code Item1] {*}$args + return +} + +proc ::canvas::drag::group {c tag cmdprefix args} { + # Set up dragging a group of items, with each group's drag + # handle(s) identified by , and the taking the + # handle item which triggered the drag and returning a tag which + # identifies the whole group to move. + + on $c $tag [namespace code [list ItemGroup $cmdprefix]] {*}$args + return +} + +proc ::canvas::drag::on {c tag cmdprefix args} { + # Setting up a general drag, with the drag handles identified by + # and providing start/move methods invoked to + # initialize and perform the drag. The cmdprefix is fully + # responsible for how the dragging of a particular handle is + # handled. + + variable attached + + # Process options (-event) + set events [dict get [Options {*}$args] event] + + # Save the (canvas, tag) combination for use by 'off'. + set k [list $c $tag] + set attached($k) $events + + # Install the bindings doing the drag + lassign $events trigger motion untrigger + $c bind $tag $trigger [namespace code [list Start $c $cmdprefix %x %y]] + $c bind $tag $motion [namespace code [list Move $c $cmdprefix %x %y]] + $c bind $tag $untrigger [namespace code [list Done $c $cmdprefix %x %y]] + return +} + +proc ::canvas::drag::off {c tag} { + # Remove a drag identified by canvas and tag. + + variable attached + + # Find and remove the bindings for this particular canvas,tag + # combination. + set k [list $c $tag] + foreach event $attached($k) { + $c bind $tag $event {} + } + + # Update our database + unset attached($k) + return +} + +# ### ### ### ######### ######### ######### +## Option processing. + +proc ::canvas::drag::Options {args} { + # Button 3 is default for dragging. + set config [list event [Validate 3]] + + foreach {option value} $args { + switch -exact -- $option { + -event { + dict set config event [Validate $value] + } + default { + return -code error "Unknown option \"$option\", expected -event" + } + } + } + + return $config +} + +# ### ### ### ######### ######### ######### +## Event parsing and transformation + +proc ::canvas::drag::Validate {event} { + # Assumes that events are specified in the forms + # -