github.tcl 3.1 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091
  1. package require tls
  2. package require http
  3. ::http::register https 443 ::tls::socket
  4. namespace eval ::github {
  5. variable libdir [file normalize [file join [file dirname [info script]] ..]]
  6. if {[lsearch $::auto_path $libdir] == -1} {
  7. lappend auto_path $libdir
  8. }
  9. }
  10. package provide github::github 0.4
  11. package provide github 0.4
  12. # Main procedure to download GitHub repository as a .tar.gz archive
  13. proc ::github::github {cmd owner repo folder {branch "BlackTools-3.0"}} {
  14. variable libdir
  15. set url https://api.github.com/repos/$owner/$repo/tarball/$branch
  16. download_archive $url $folder
  17. }
  18. # Background download with wget
  19. proc ::github::download_archive {url folder} {
  20. # Create the folder if it doesn't exist
  21. if {![file exists $folder]} {
  22. file mkdir $folder
  23. }
  24. # Define the path for the downloaded archive
  25. set archive_path [file join $folder "bt.tar.gz"]
  26. # Run the wget command in the background
  27. set command "curl -L -o $archive_path $url &"
  28. if {[catch {exec {*}$command} errMsg]} {
  29. putlog "\[BT\] - AutoUpdate - Error: Failed to start download $url in background"
  30. putlog "\[BT\] - AutoUpdate - Details: $errMsg"
  31. return
  32. }
  33. # Check periodically if download is complete
  34. utimer 5 [list ::github::check_download_complete $archive_path $folder]
  35. }
  36. # Periodically check if the download is complete
  37. proc ::github::check_download_complete {archive_path folder} {
  38. # If the download is complete, proceed with extraction
  39. if {[file exists $archive_path] && [file size $archive_path] > 0} {
  40. if {[catch {::github::unpack_archive $archive_path $folder} errMsg]} {
  41. putlog "\[BT\] - AutoUpdate - Error: Failed to unpack archive $archive_path"
  42. putlog "\[BT\] - AutoUpdate - Details: $errMsg"
  43. } else {
  44. putlog "\[BT\] - AutoUpdate - Successfully unpacked archive to $folder"
  45. }
  46. # Clean up the archive file after extraction
  47. file delete $archive_path
  48. } else {
  49. # Re-check in 5 seconds if download isn't complete
  50. utimer 5 [list ::github::check_download_complete $archive_path $folder]
  51. }
  52. }
  53. # Unpack the .tar.gz archive into the specified folder
  54. proc ::github::unpack_archive {archive_path folder} {
  55. # Define a temporary folder for unpacking
  56. set temp_folder [file join $folder "temp_unpack"]
  57. # Ensure the temporary folder exists
  58. if {![file exists $temp_folder]} {
  59. file mkdir $temp_folder
  60. }
  61. # Extract the tarball into the temporary folder
  62. if {[catch {exec tar -xzf $archive_path -C $temp_folder} errMsg]} {
  63. putlog "\[BT\] - AutoUpdate - Error: Failed to extract $archive_path"
  64. putlog "\[BT\] - AutoUpdate - Details: $errMsg"
  65. return
  66. }
  67. # Locate the first directory inside temp_unpack (e.g., "owner-repo-branch")
  68. set extracted_dir [lindex [glob -directory $temp_folder *] 0]
  69. # Move contents from the extracted directory to the target folder
  70. foreach item [glob -directory $extracted_dir *] {
  71. file rename -force $item $folder/
  72. }
  73. # Clean up the temporary folder and extracted directory
  74. file delete -force $temp_folder
  75. }