1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . D I R E C T O R I E S . V A L I D I T Y -- 6-- -- 7-- B o d y -- 8-- (Windows Version) -- 9-- -- 10-- Copyright (C) 2004-2015, Free Software Foundation, Inc. -- 11-- -- 12-- GNAT is free software; you can redistribute it and/or modify it under -- 13-- terms of the GNU General Public License as published by the Free Soft- -- 14-- ware Foundation; either version 3, or (at your option) any later ver- -- 15-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 16-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 17-- or FITNESS FOR A PARTICULAR PURPOSE. -- 18-- -- 19-- As a special exception under Section 7 of GPL version 3, you are granted -- 20-- additional permissions described in the GCC Runtime Library Exception, -- 21-- version 3.1, as published by the Free Software Foundation. -- 22-- -- 23-- You should have received a copy of the GNU General Public License and -- 24-- a copy of the GCC Runtime Library Exception along with this program; -- 25-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 26-- <http://www.gnu.org/licenses/>. -- 27-- -- 28-- GNAT was originally developed by the GNAT team at New York University. -- 29-- Extensive contributions were provided by Ada Core Technologies Inc. -- 30-- -- 31------------------------------------------------------------------------------ 32 33-- This is the Windows version of this package 34 35with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; 36 37package body Ada.Directories.Validity is 38 39 Invalid_Character : constant array (Character) of Boolean := 40 (NUL .. US | '\' => True, 41 '/' | ':' | '*' | '?' => True, 42 '"' | '<' | '>' | '|' => True, 43 DEL => True, 44 others => False); 45 -- Note that a valid file-name or path-name is implementation defined. 46 -- To support UTF-8 file and directory names, we do not want to be too 47 -- restrictive here. 48 49 --------------------------------- 50 -- Is_Path_Name_Case_Sensitive -- 51 --------------------------------- 52 53 function Is_Path_Name_Case_Sensitive return Boolean is 54 begin 55 return False; 56 end Is_Path_Name_Case_Sensitive; 57 58 ------------------------ 59 -- Is_Valid_Path_Name -- 60 ------------------------ 61 62 function Is_Valid_Path_Name (Name : String) return Boolean is 63 Start : Positive := Name'First; 64 Last : Natural; 65 66 begin 67 -- A path name cannot be empty, cannot contain more than 256 characters, 68 -- cannot contain invalid characters and each directory/file name need 69 -- to be valid. 70 71 if Name'Length = 0 or else Name'Length > 256 then 72 return False; 73 74 else 75 -- A drive letter may be specified at the beginning 76 77 if Name'Length >= 2 78 and then Name (Start + 1) = ':' 79 and then 80 (Name (Start) in 'A' .. 'Z' or else Name (Start) in 'a' .. 'z') 81 then 82 Start := Start + 2; 83 84 -- A drive letter followed by a colon and followed by nothing or 85 -- by a relative path is an ambiguous path name on Windows, so we 86 -- don't accept it. 87 88 if Start > Name'Last 89 or else (Name (Start) /= '/' and then Name (Start) /= '\') 90 then 91 return False; 92 end if; 93 end if; 94 95 loop 96 -- Look for the start of the next directory or file name 97 98 while Start <= Name'Last 99 and then (Name (Start) = '\' or Name (Start) = '/') 100 loop 101 Start := Start + 1; 102 end loop; 103 104 -- If all directories/file names are OK, return True 105 106 exit when Start > Name'Last; 107 108 Last := Start; 109 110 -- Look for the end of the directory/file name 111 112 while Last < Name'Last loop 113 exit when Name (Last + 1) = '\' or Name (Last + 1) = '/'; 114 Last := Last + 1; 115 end loop; 116 117 -- Check if the directory/file name is valid 118 119 if not Is_Valid_Simple_Name (Name (Start .. Last)) then 120 return False; 121 end if; 122 123 -- Move to the next name 124 125 Start := Last + 1; 126 end loop; 127 end if; 128 129 -- If Name follows the rules, it is valid 130 131 return True; 132 end Is_Valid_Path_Name; 133 134 -------------------------- 135 -- Is_Valid_Simple_Name -- 136 -------------------------- 137 138 function Is_Valid_Simple_Name (Name : String) return Boolean is 139 Only_Spaces : Boolean; 140 141 begin 142 -- A file name cannot be empty, cannot contain more than 256 characters, 143 -- and cannot contain invalid characters. 144 145 if Name'Length = 0 or else Name'Length > 256 then 146 return False; 147 148 -- Name length is OK 149 150 else 151 Only_Spaces := True; 152 for J in Name'Range loop 153 if Invalid_Character (Name (J)) then 154 return False; 155 elsif Name (J) /= ' ' then 156 Only_Spaces := False; 157 end if; 158 end loop; 159 160 -- If no invalid chars, and not all spaces, file name is valid 161 162 return not Only_Spaces; 163 end if; 164 end Is_Valid_Simple_Name; 165 166 ------------- 167 -- Windows -- 168 ------------- 169 170 function Windows return Boolean is 171 begin 172 return True; 173 end Windows; 174 175end Ada.Directories.Validity; 176