Skip async fetch if file is already being fetched

Can happen when a distfile is shared by multiple ports that will be
built from source by the same action.

Closes: https://trac.macports.org/ticket/73587
(cherry picked from commit c4d21762d0)

src/macports1.0/macports.tcl

@@ -2132,6 +2132,7 @@ proc macports::worker_init {workername portpath porturl portbuildpath options va
     $workername alias curlwrap_async_cancel macports::curlwrap_async_cancel
     $workername alias curlwrap_async_is_complete macports::curlwrap_async_is_complete
     $workername alias curlwrap_async_show_progress macports::curlwrap_async_show_progress
+    $workername alias curlwrap_async_file_is_in_progress macports::curlwrap_async_file_is_in_progress
 
     foreach opt $portinterp_options {
         if {![info exists $opt]} {
@@ -2274,6 +2275,11 @@ proc macports::curlwrap_async_show_progress {id} {
     return [mport_fetch_thread::show_progress $id]
 }
 
+# Check if a transfer is in progress for a file
+proc macports::curlwrap_async_file_is_in_progress {path} {
+    return [mport_fetch_thread::file_is_in_progress $path]
+}
+
 ##
 # Extracts a Portfile from a tarball pointed to by the given \a url to a path
 # in \c $portdbpath and returns its path.

src/macports1.0/mport_fetch_thread.tcl

@@ -37,6 +37,7 @@ package require Thread
 
 namespace eval mport_fetch_thread {
     variable active_requests [dict create]
+    variable active_files [dict create]
     variable next_id 0
     variable management_thread
     trace add variable management_thread read mport_fetch_thread::init_management_thread
@@ -349,6 +350,19 @@ proc mport_fetch_thread::init_management_thread {args} {
     thread::send -async $management_thread [list init_max_threads $max_fetches]
 }
 
+proc mport_fetch_thread::record_request {op opargs id} {
+    variable active_requests
+    if {$op eq "fetch_file"} {
+        # record the file path
+        set val [lindex $opargs 3]
+        variable active_files
+        dict set active_files $val 1
+    } else {
+        set val {}
+    }
+    dict set active_requests $id $val
+}
+
 # Queue a fetch operation to be performed on a thread in the background.
 # Returns an id that can be used with the get_result command.
 proc mport_fetch_thread::queue {op opargs} {
@@ -359,8 +373,7 @@ proc mport_fetch_thread::queue {op opargs} {
     set id [namespace which -variable $result_name]
     variable management_thread
     thread::send -async $management_thread [list queue_request $op $opargs [thread::id] $id]
-    variable active_requests
-    dict set active_requests $id 1
+    record_request $op $opargs $id
     return $id
 }
 
@@ -369,6 +382,11 @@ proc mport_fetch_thread::queue {op opargs} {
 proc mport_fetch_thread::get_result {id} {
     variable active_requests
     if {[dict exists $active_requests $id]} {
+        set filepath [dict get $active_requests $id]
+        if {$filepath ne {}} {
+            variable active_files
+            dict unset active_files $filepath
+        }
         dict unset active_requests $id
         variable $id
         if {![info exists $id]} {
@@ -413,6 +431,12 @@ proc mport_fetch_thread::is_complete {id {timeout 0}} {
     }
 }
 
+# Check if a fetch is in progress for the given file path
+proc mport_fetch_thread::file_is_in_progress {path} {
+    variable active_files
+    return [dict exists $active_files $path]
+}
+
 # Start displaying progress for the operation identified by id.
 proc mport_fetch_thread::show_progress {id} {
     variable active_requests
@@ -435,6 +459,11 @@ proc mport_fetch_thread::cancel {id} {
         # Not in progress, guess it's fine?
         return
     }
+    set filepath [dict get $active_requests $id]
+    if {$filepath ne {}} {
+        variable active_files
+        dict unset active_files $filepath
+    }
     dict unset active_requests $id
     variable $id
     if {[info exists $id]} {

src/port1.0/portfetch.tcl

@@ -532,6 +532,10 @@ proc portfetch::fetchfiles {{async no} args} {
                 set urlmap($url_var) $urlmap(master_sites)
             }
             if {$async} {
+                # Skip if something else is already fetching this file
+                if {[curlwrap_async_file_is_in_progress ${distpath}/${distfile}]} {
+                    continue
+                }
                 file delete -force ${distpath}/${distfile}.TMP
                 touch ${distpath}/${distfile}.TMP
                 chownAsRoot ${distpath}/${distfile}.TMP